Hello all,

I have a bit of code that takes a long time to run, and I was wondering if there was a way to optimize it to run faster (or a different approach to what I am doing, as I am relatively new to VBA), or if it is the number of records I am hitting against that is slowing this down.

Cliff notes on what I am doing, I have multiple sheets with ~ 55k records on each. I want to search all of these sheets (the code I will post below is only searching the first two) for all rows that match a certain criteria, and if a row matches, move it to a summary sheet (Results). This is what I have so far (it works, but very slowly):


Sub RetrieveAll()
Dim eadd As String
Dim matchrow As Long
Dim LastRow As Long

Application.ScreenUpdating = False



Sheets("Report").Select
eadd = Range("B1")


With Sheets("AggregatedOrders1").Range("I2:I65000")

    Set c = .Find(eadd, LookIn:=xlValues)
    If Not c Is Nothing Then
    firstAddress = c.Address
    
    Do
    matchrow = c.Row
    Sheets("AggregatedOrders1").Rows(matchrow).Copy
    Sheets("Report").Activate
    LastRow = Range("A" & Rows.Count).End(xlUp).Row

    Cells(LastRow + 1, 1).Select
    ActiveSheet.Paste
    
    Set c = .FindNext(c)
       
    
    
    Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

With Sheets("AggregatedOrders2").Range("I2:I65000")

    Set c = .Find(eadd, LookIn:=xlValues)
    If Not c Is Nothing Then
    firstAddress = c.Address
   
    Do
    matchrow = c.Row
    Sheets("AggregatedOrders2").Rows(matchrow).Copy
    Sheets("Report").Activate
    LastRow = Range("A" & Rows.Count).End(xlUp).Row

    Cells(LastRow + 1, 1).Select
    ActiveSheet.Paste
    
    Set c = .FindNext(c)
       
    
    
    Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With


End Sub