Delete rows if value is not mentioned in range - vba

Question

Out of a file with approximately 50.000 rows I want to delete rows which don't have a specific number in column B. I use this code:
Sub DelRows()
Application.ScreenUpdating = False
Worksheets("2016").Activate
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = lastrow To 2 Step -1
If Cells(i, "B").Value <> "1060" And _
Cells(i, "B").Value <> "1061" And _
Cells(i, "B").Value <> "1062" And _
Cells(i, "B").Value <> "1063" And _
Cells(i, "B").Value <> "1064" And _
Cells(i, "B").Value <> "1105" And _
Cells(i, "B").Value <> "11050" And _
Cells(i, "B").Value <> "11051" And _
Cells(i, "B").Value <> "11053" And _
Cells(i, "B").Value <> "11054" And _
Cells(i, "B").Value <> "1160" And _
Cells(i, "B").Value <> "1161" And _
Cells(i, "B").Value <> "1162" And _
Cells(i, "B").Value <> "1163" And _
Cells(i, "B").Value <> "1164" And _
Cells(i, "B").Value <> "1166" And _
Cells(i, "B").Value <> "1168" And _
Cells(i, "B").Value <> "1169" And _
Cells(i, "B").Value <> "8060" And _
Cells(i, "B").Value <> "8061" And _
Cells(i, "B").Value <> "8062" And _
Cells(i, "B").Value <> "8063" And _
Cells(i, "B").Value <> "8064" And _
Cells(i, "B").Value <> "8068" And _
Cells(i, "B").Value <> "8192" Then
Cells(i, "B").EntireRow.Delete
End If
Next i
End Sub
This macro takes a lot of time and it seems to be that there is a maximum of 'and-statements'.
I tried to figure it out with an array or a filter, but it's hard for me as a beginner.
I would like to put the numbers on a separate worksheet as a range e.g.:
A
1 1060
2 1061
3 1062
4 1063
5 1064
…
I've tried to figure it out with section Criteria range on a different sheet* on https://www.rondebruin.nl/win/winfiles/MoreDeleteCode.txt, but I don't fully understand this VBA code.
Can somebody please help me?
Kind regards,
Richard

Answer 1

Let's say the values are as in the code below - rngCheck and rngDelete.
A nested loop can do exactly this job. The outer loop goes through the range, which should be deleted rngDelete and the inner goes through the checking values rngCheck.
If a matching value is found, it is deleted and the inner loop is exited. As far as we are looping through rows and we need to delete some of them, the for loop is with reversed counting:
Option Explicit
Public Sub TestMe()
Dim cnt As Long
Dim rngDelete As Range
Dim rngCheck As Range
Dim rngCell As Range
Set rngCheck = Worksheets(2).Range("A1:A2")
Set rngDelete = Worksheets(1).Range("A1:A20")
For cnt = rngDelete.Rows.Count To 1 Step -1
For Each rngCell In rngCheck
If rngCell = rngDelete.Cells(cnt, 1) Then
rngDelete.Rows(cnt).Delete
Exit For
End If
Next rngCell
Next cnt
End Sub

Answer 2

Here's an array approach which saves on reading from and writing to spreadsheets and so should be a bit quicker. This method includes the cells which do match rather than excluding those which don't. Adjust your range of cells against which you are checking accordingly. I have assumed your data start in A1 of sheet 2016.
Sub DelRows()
Dim v, i As Long, j As Long, vOut(), k As Long, rExcl As Range
Set rExcl = Sheets("Sheet2").Range("A1:A5") 'adjust accordingly
With Worksheets("2016")
v = .Range("A1").CurrentRegion.Value
.Range("A1").CurrentRegion.Offset(1).ClearContents
ReDim vOut(1 To UBound(v, 1), 1 To UBound(v, 2))
For i = LBound(v, 1) To UBound(v, 1)
If IsNumeric(Application.Match(v(i, 2), rExcl, 0)) Then
j = j + 1
For k = LBound(v, 2) To UBound(v, 2)
vOut(j, k) = v(i, k)
Next k
End If
Next i
.Range("A2").Resize(j, UBound(v, 2)) = vOut
End With
End Sub