Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to avoid need to activate worksheet every loop

Tags:

excel

vba

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
like image 882
pnbjam Avatar asked Nov 23 '25 18:11

pnbjam


1 Answers

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?

like image 136
EEM Avatar answered Nov 26 '25 11:11

EEM