Find Method loop is slowing down

[arjking]

Thanks to this forum I have recently learned to use the Find Method.

My code is designed to detect a row in one table that does not exist in another table. I loop through every cell in the first table and test a Find statement searching the other table. This loops through about 2000 times. I noticed via the immediate window that each find takes a little longer than the last so that by the time I get to the upper 1000's it is crawling. I'm curious as to why this is so and what I can do to fix it.

BLANKINCOLUMN and LASTINCOLUMN are functions that find the the last cell/blank in a column.

Private Sub ReportNewRowsA()
  Dim rngVLImport1, rngVLImport2, rngVLCurrent1, rngVLCurrent2, cell1, cell2 As Range
  With Workbooks(wbFutureName).Sheets(wbImportName)
    Set rngVLImport1 = .Range("A3:A" & LASTINCOLUMN(.Range("A3"))) 'This is the table with the new rows
    Set rngVLImport2 = .Range("DA3:DA" & LASTINCOLUMN(.Range("DA3"))) 'Not used
  End With
 
  With Workbooks(wbFutureName).Sheets(wbCurrentName)
    Set rngVLCurrent1 = .Range("A3:A" & LASTINCOLUMN(.Range("A3"))) 'This is the table being searched
    Set rngVLCurrent2 = .Range("DA3:DA" & LASTINCOLUMN(.Range("DA3"))) 'Not used
  End With
 
  With Workbooks(wbFutureName)
    For Each cell1 In rngVLImport1.Cells
      If rngVLCurrent1.Find(What:=cell1.Value, _
                            After:=.Sheets(wbCurrentName).Range("A3"), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext) Is Nothing Then
        .Sheets(wbImportName).Range("A" & cell1.row & ":AH" & cell1.row).Copy _
        Destination:=.Sheets("New Rows").Range("A" & BLANKINCOLUMN(.Sheets("New Rows").Range("A1")))
        'Debug.Print BLANKINCOLUMN(.Sheets("New Rows").Columns("A"))
      End If
      Debug.Print cell1.Address
    Next cell1
  End With
End Sub