Change definite value to string reference for criteria

[J.W. Aldridge]

Instead of deleting just two criteria in the code ("apples" &
"oranges"), I need it to look at values in string on Sheet "grapes",
Reference A5:A15.

Sub Delete_with_Autofilter_Two_Criteria1()
Dim DeleteValue1 As String
Dim DeleteValue2 As String
Dim rng As Range
Dim calcmode As Long

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

'Fill in the two values that you want to delete
DeleteValue1 = "apples"
DeleteValue2 = "oranges"

'Sheet with the data, you can also use Sheets("MySheet")
With ActiveSheet

'Firstly, remove the AutoFilter
.AutoFilterMode = False

'Apply the filter
.Range("H1:H" & .Rows.Count).AutoFilter Field:=1, _
Criteria1:=DeleteValue1, Operator:=xlOr,
Criteria2:=DeleteValue2

With .AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With

'Remove the AutoFilter
.AutoFilterMode = False
End With

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

End Sub

 

[Don Guillett Excel MVP]

Instead of deleting just two criteria in the code ("apples" &
"oranges"), I need it to look at values in string on Sheet "grapes",
Reference A5:A15.

Sub Delete_with_Autofilter_Two_Criteria1()
    Dim DeleteValue1 As String
    Dim DeleteValue2 As String
    Dim rng As Range
    Dim calcmode As Long

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

    'Fill in the two values that you want to delete
    DeleteValue1 = "apples"
    DeleteValue2 = "oranges"

    'Sheet with the data, you can also use Sheets("MySheet")
    With ActiveSheet

        'Firstly, remove the AutoFilter
        .AutoFilterMode = False

        'Apply the filter
        .Range("H1:H" & .Rows.Count).AutoFilter Field:=1, _
        Criteria1:=DeleteValue1, Operator:=xlOr,
Criteria2:=DeleteValue2

        With .AutoFilter.Range
            On Error Resume Next
            Set rng = .Offset(1, 0).Resize(.Rows.Count - 1,1) _
                      .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rng Is Nothing Then rng.EntireRow.Delete
        End With

        'Remove the AutoFilter
        .AutoFilterMode = False
    End With

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

End Sub

Probably just as easy and just as fast to simply use

dim i as long
for i = cells(rows.count,"a").end(xlup).row to 2 step -1
if lcase(cells(i,"a"))="apples" or _
lcase(cells(i,"a"))="oranges" or _
lcase(cells(i,"a"))="grapes" then rows(i).delete
next i