1
votes

I am trying to cycle through all worksheets apart from one called 'summary', looking down a range in column A until finding a value, then looking in another workbook and getting some data, pasting it in, then carrying on until the end of column A range. Then it should move onto the next worksheet and repeat the process. I have been able to execute the code within the loop successfully, but only on the active worksheet. I've tried various iterations of the 'for each' statements. The current way seems to loop through the worksheets but doesn't run the code.

How can i amend it so it works properly?

    Sub GetFlows()

Dim rng As Range
Dim row As Range
Dim cell As Range
Dim dem1 As String
Dim WhereCell As Range
Dim ws As Excel.Worksheet
Dim iIndex As Integer

Dim valueRng As Range
Dim x As Long
Dim y As Long


Set rng = Range("A9:A200")

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "summary" Then
        ws.Activate
            For x = 1 To rng.Rows.Count

            dem1 = rng.Cells(x).Value

            If dem1 <> "" Then
                Set WhereCell = ThisWorkbook.ActiveSheet.Range("A9:A200").Find(dem1, lookat:=xlPart)
                Windows("GetFilenames v2.xlsm").Activate
                Worksheets(dem1).Range("A1").CurrentRegion.Copy
                WhereCell.Offset(, 2).PasteSpecial Paste:=xlPasteValues
                Else
                ThisWorkbook.Activate
            End If

            Next x
    End If
Next ws


End Sub
2
the first step is to isolate your problem: Does your code run? Add a breakpoint or a MsgBox function call within the loop, then run the code and see if it hits. If not, then your conditional logic is wrong. If so, then step through using F8 to debug and see what breaks.David Zemens
see this advice for how to debug VBADavid Zemens
You're also going to want to avoid using select/activate since even relatively simple code such as yours can quickly become convoluted and difficult to trace, if you're constantly "Activating" and selecting various workbooks or worksheets. It's 99.9% unnecessary to do that, and doing that actually makes your code much harder to read, debug, etc.David Zemens

2 Answers

2
votes

You could avoid all the Activate and Select and qualify all your Range and Cells statemets inside by using With ws.

So after you loop through all your Worksheets in :

For Each ws In ThisWorkbook.Worksheets , you add With ws and all the objects inside are qualified with the ws object.

Code:

Option Explicit

Sub GetFlows()

Dim cell As Range
Dim dem1 As String
Dim WhereCell As Range
Dim ws As Worksheet

Dim valueRng As Range
Dim x As Long
Dim y As Long

For Each ws In ThisWorkbook.Worksheets
    With ws
        If .Name <> "summary" Then
            For x = 9 To 200 ' run a loop from row 9 to 200
                dem1 = .Range("A" & x).Value

                If dem1 <> "" Then
                    Set WhereCell = .Range("A9:A200").Find(what:=dem1, LookAt:=xlPart)
                    If Not WhereCell Is Nothing Then
                        Workbooks("GetFilenames v2.xlsm").Worksheets(dem1).Range("A1").CurrentRegion.Copy
                        WhereCell.Offset(, 2).PasteSpecial xlPasteValues
                    End If
                End If
            Next x
        End If
    End With
Next ws

End Sub
2
votes

Can you try this? This checks if the value is found.

Sub GetFlows()

Dim rng As Range
Dim row As Range
Dim cell As Range
Dim dem1 As String
Dim WhereCell As Range
Dim ws As Excel.Worksheet
Dim iIndex As Integer

Dim valueRng As Range
Dim x As Long
Dim y As Long

Set rng = Range("A9:A200") ' should specify a sheet here, presumably Summary?

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "summary" Then
        For x = 1 To rng.Rows.Count
            dem1 = rng.Cells(x).Value
            If dem1 <> vbNullString Then
                Set WhereCell = ws.Range("A9:A200").Find(dem1, lookat:=xlPart)
                If Not WhereCell Is Nothing Then
                    Workbooks("GetFilenames v2.xlsm").Worksheets(dem1).Range("A1").CurrentRegion.Copy
                    WhereCell.Offset(, 2).PasteSpecial Paste:=xlPasteValues
                End If
            End If
        Next x
    End If
Next ws

End Sub