如果范围内未提及值，则删除行

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 eg:

     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