pnbjam
pnbjam

Reputation: 33

How to avoid need to activate worksheet every loop

I've set up some VBA code in Excel that asks the user to select a second worksheet, then searches it for a value (a shared key linking the two sets of data, found 6 columns after Rng, where I want to add the retrieved value) in the second table and adds a value from that row to a column in the original table. The part of the program that I would like to adjust is the loop below.

It works fine if when I leave in the line to activate the CurFile workbook. But it means my screen is flashing a lot back and forth between the two workbooks. And once I start getting into hundreds or thousands of lines of data it will be ridiculously slow.

When I comment out that line, the value for FindCID doesn't change and it seems to just keep on refilling the same line, even though the value for r is updating. If after a few loops I add the activate line back in, it resumes properly filling in the results several lines down.

How can I streamline this? I originally was using ThisWorkbook references but even with explicitly defining CurFile (CurFile = ActiveWorkbook.Name) earlier it doesn't seem to go back to that workbook to look up the next value to search for, unless I reactivate the sheet.

Do While r <= maxRows

With Workbooks(CurFile).Worksheets("Sheet1")
    Set Rng = .Range(Cells(r, c), Cells(r, c))
End With

FindCID = Rng.Offset(0, 6).Value

If Trim(FindCID) <> "" Then
    With Workbooks(FN)   ' found earlier by a function
       .Activate
    End With

    With Sheets("Sheet1").Range("D:D")
        Set FoundCell = .Find(What:=FindCID)
            If Not FoundCell Is Nothing Then
                PathLen = FoundCell.Offset(0, 2).Value
  Workbooks(CurFile).Sheets("Sheet1").Activate 'If I comment out this line it doesn't work
                Rng.Value = PathLen
                MsgBox "CID found in " & FoundCell.Address & " Its value is " & PathLen
            Else
                MsgBox "Nothing found"
            End If
    End With
End If

On Error Resume Next

r = r + 1
Loop

Upvotes: 3

Views: 1667

Answers (1)

EEM
EEM

Reputation: 6659

Actually when working with objects, in most of the cases, there is no need to activate the workbooks\worksheets. This is your code with some modifications in this regard:

Application.ScreenUpdating = False '(as suggested by CBRF23)
'......
'begining of your code
'......

Do While r <= maxRows

    With Workbooks(CurFile).Worksheets("Sheet1")
        Set Rng = .Cells(r, c) '(1)
    End With

    FindCID = Rng.Offset(0, 6).Value2        
    If Trim(FindCID) <> "" Then
        Set FoundCell = Workbooks(FN).Sheets("Sheet1").Range("D:D").Find(What:=FindCID)
        If Not FoundCell Is Nothing Then Rng.Value = FoundCell.Offset(0, 2).Value2
    End If

    r = r + 1
Loop
'......
'rest of your code
'......
Application.ScreenUpdating = True

(1) Notice that way the Range is defined as it’s made of only once Cell; but if the range has more than one Cell i.e. from Cell(r,c) to Cell(r,c+5) then you need to use the form:

Set Rng = Range(.Cells(r, c), .Cells(r, c+5))

There is no need to add a period . before Range as the range is defined by the Cells within the Range command. By using the period . before the Cell command they are referred as part of the

With Workbooks(CurFile).Worksheets("Sheet1")

However if the Range is defined as A1:F1 then the period . has to be added before the Range as in:

Set Rng = .Range(“A1:F1”)

I removed the MsgBox commands as I believe they were just for testing purposes. Not really showing these messages for hundreds or thousands lines of data. Isn’t it?

Upvotes: 1

Related Questions