Delete rows with specific values

Any trics to make code below faster/easier/shorter?
I'm also out of OR statements and need to add more, I don't know how.
Thanks in advice for any help with this one.

Dim Firstrow2 As Long
Dim Lastrow2 As Long
Dim Lrow2 As Long
Dim CalcMode2 As Long
Dim ViewMode2 As Long

    With Application
        CalcMode2 = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    With ActiveSheet
        .Select
        Firstrow2 = .UsedRange.Cells(1).Row
        Lastrow2 = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        
        For Lrow2 = Lastrow To Firstrow Step -1
            With .Cells(Lrow2, "F")

                If Not IsError(.Value) Then
                    
                    'Voeg NIS9 hier toe (onterecht dubbel)
                    If .Value = ("BE37015A02-120207000084") _
                    Or .Value = ("BE33011A001120576000014") _
                    Or .Value = ("BE44011A01-134172000034") _
                    Or .Value = ("BE37017A091118503000004") _
                    Or .Value = ("BE45035A632132908000003") _
                    Or .Value = ("BE34003A072115437000029") _
                    Or .Value = ("BE43005A374135796000015") _
                    Or .Value = ("BE37010A091156389000005B") _
                    Or .Value = ("BE37017A0WN118524000003") _
                    Or .Value = ("BE34023A294117483000005") _
                    Or .Value = ("BE34009A0PA117866000005") _
                    Or .Value = ("BE31005A671105649000009009") _
                    Or .Value = ("BE37017C01-118605000002") _
                    Or .Value = ("BE34022D0MN114629000007") _
                    Or .Value = ("BE34022C001116162000130") _
                    Or .Value = ("BE34022A54-137870000034") _
                    Or .Value = ("BE31005F210110176000029") _
                    Or .Value = ("BE34040C081117991000112") _
                    Or .Value = ("BE45035A772132666000004") _
                    Or .Value = ("BE31005C0MA110872000002") _
                    Or .Value = ("BE31005Z999142428000003") _
                    Or .Value = ("BE45017A572133796000015A") _
                    Or .Value = ("BE54010E181103450000228") _
                    Or .Value = ("BE31005A211105684000010") _
                    Then .EntireRow.Delete
                
                End If

            End With

        Next Lrow2

    End With

    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

Administrative Note:

Welcome to the forum.

We would very much like to help you with your query, however you need to include code tags around your code.

Please take a moment to add the tags. Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Click on Edit to open your post, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

(Note: this change is not optional. No help to be offered until this moderation request has been fulfilled.)

Hi louvaek,

One way to get around the issue with all the or statements (and not having room for more) would be to add the items to a dictionary, and then just using that for a simple check. It may also speed things up slightly since the comparison gets simplified, but I doubt it will make a huge performance difference. I changed your loop because it said " For Lrow2 = Lastrow To Firstrow Step -1" but your variables have a 2 after them so this loop when tested was giving me Lrow2 values of 0

Sub louvaek()

Dim Firstrow2 As Long
Dim Lastrow2 As Long
Dim Lrow2 As Long
Dim CalcMode2 As Long
Dim ViewMode2 As Long
Dim myDict As Object

    With Application
        CalcMode2 = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    
    Set myDict = CreateObject("Scripting.Dictionary")
    myDict("BE37015A02-120207000084") = Empty
    myDict("BE33011A001120576000014") = Empty
    myDict("BE44011A01-134172000034") = Empty
    'etc
    
    With ActiveSheet
        .Select
        Firstrow2 = .UsedRange.Cells(1).Row
        Lastrow2 = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        
        For Lrow2 = Lastrow2 To Firstrow2 Step -1
            With .Cells(Lrow2, "F")

                If Not IsError(.Value) Then
                    
                    'Voeg NIS9 hier toe (onterecht dubbel)
                    If myDict.exists(.Value) Then .EntireRow.Delete
                
                End If

            End With

        Next Lrow2

    End With

    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

End Sub