Deleting row if value exists

[thomassharp]

Hi everyone, can the code below be modified to search for multiple values? So entering a list of 50 values to delete all rows containing each value?

Sub Loop_Example()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long


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


    With Sheet1


        .Select


        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView


        .DisplayPageBreaks = False


        Firstrow = 2
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row


        For Lrow = Lastrow To Firstrow Step -1


            With .Cells(Lrow, "I")


                If Not IsError(.Value) Then


                    If .Value = "James Fleming & Co Ltd" Then .EntireRow.Delete
                   


                End If


            End With


        Next Lrow


    End With


    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With


End Sub

Thank you!!

 

[Mike LH]

Hi,

I think it a mistake to hard code that amount of text strings, I would store them in a worksheet range like this. My checkrange is a1:a10 on sheet 2 but you can put it anywhere

Sub Loop_Example()
Dim ChkRange As Range
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long
Set ChkRange = Sheets("Sheet2").Range("A1:A10")
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    With Sheet1
        .Select
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView
        .DisplayPageBreaks = False
        Firstrow = 2
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Lrow = Lastrow To Firstrow Step -1
            With .Cells(Lrow, "I")
                If Not IsError(.Value) Then
                    If Not IsError(Application.Match(.Value, ChkRange, 0)) Then
                    .EntireRow.Delete
                    End If
                End If
            End With
        Next Lrow
    End With
    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

 

[thomassharp]

Solved. Great, what a simple and effective solution. Thanks a lot