VBA: Loop through an string array of variants and delete rows if matching value

Question

I've got multiple text variables (fruits) that when and if they appear on column RI need to delete the entire row. I've got the following code, but as I have 15 variables of "Fruit" (and may need to add more in the future) I was wondering how I could make this is a single subroutine with a loop. I tried many ways failing miserably. Possibly with a string array including all the names?

Thanks in advance,

Sub Fix1()
Dim Fruit As String

Fruit = "Apple"

Do
On Error GoTo ByeBye
Range("R:R").Find(Fruit).EntireRow.Delete
Loop
ByeBye:
Exit Sub
End Sub



Sub Fix2()
Dim Fruit As String

Fruit = "Orange"
Do
On Error GoTo ByeBye
Range("R:R").Find(Fruit).EntireRow.Delete
Loop
ByeBye:
Exit Sub
End Sub

Answer 1

you could use AutoFiter() :

Sub FixAll()
    Dim Fruits As Variant

    Fruits = Array("Apple", "Banana", "Pear") '<--| list your fruits
    With Range("R:R") '<--| reference your range
        .AutoFilter Field:=1, Criteria1:=Fruits, Operator:=xlFilterValues '<--| filter referenced column with 'Fruits'" content
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '<--| if any cell found other than header one then delete its corresponding row
    End With
    ActiveSheet.AutoFilterMode = False
End Sub

Answer 2

If you don't need the first row deleted:

Dim r As Range
Set r = ActiveSheet.UsedRange

r.AutoFilter 19 - r.Column, Array("Apple", "Orange"), xlFilterValues 
r.Offset(1).Delete xlShiftUp                               ' deletes the non-filtered rows
r.AutoFilter                                               ' hide the filter