Search code examples
vbaexcellarge-data

Excel VBA delete row if cell value not found in a column in other sheet


I am new to VBA and dealing with a huge data set here. I am trying to get rid of observations that do not meet one criteria. I need to go through each cell of Column1 in Sheet1 (around 200,000 rows) and check if the cell value is among accepted values listed in Column1 in Sheet2 (there are some 3000+ rows there). If it is then move forward, if it's not then the whole row with the cell in Sheet1 needs to be deleted.

The code below does not seem to work properly, for example it does not delete all the rows at once, but has to be run several times, and takes ages. I am not sure if the Find method is doing the right job either. Any help would be highly appreciated!

(There are multiple cells in Column1 of Sheet1 that have the same value, and they are ordered according to value, is it also possible to speed up the whole process by deleting all of them at once?)

Sub DeleteRows
'Deletes rows where one cell does not meet criteria

Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Dim criteria As String
Dim found As Range
Dim i As Long

Application.ScreenUpdating = False

 For i = 2 To 200000 
   criteria = ws1.Cells(i, 1).Value
   On Error Resume Next
   Set found = ws2.Range("A:A").Find(What:=criteria, LookAt:=xlWhole) 
   On Error GoTo 0

   If found Is Nothing Then
     ws1.Cells(i, 1).EntireRow.Delete
   End If
  Next i

Application.ScreenUpdating = True

End Sub

Solution

  • When deleting rows you need to go from bottom to top otherwise you would risk missing some rows (as you have encountered). You should therefore replace...

    For i = 2 To 200000 
    

    ...with...

    For i = 200000 To 2 Step -1 
    

    ...in you code, and it should work as intended.