Search for every value in a certain range and delete any row that contains any

[TimBZKK]

Hello! I have a macro that searches a worksheet for a word, and deletes any row that contains that word. I would like to, instead, use a range of words, and delete any row that contains any word in the range! Here is what I have so far.

Sub SearchForZirh()

With ActiveSheet



  Set rngFindTotal = .Cells.Find("Zirh", LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)



  While Not rngFindTotal Is Nothing



     .Rows(rngFindTotal.Row).Delete

     

     Set rngFindTotal = .Cells.FindNext



  Wend



End With

End Sub

The Range I wish to use is D2:D20 on the worksheet "Config". This macro is going to be used on multiple different worksheets, but the range of words I'm going to use will always be Config!D2:D20.

Thank you for your time!

[jasoncw]

You could loop through D2:D20, something like:

For Each cell In .Range("D2:D20")

    If Not cell = "" Then  'does not search if cell is blank
    
        ...your code here...
    
    End If
    
Next cell

[TimBZKK]

Maybe I should be more clear. What I am looking for instead of

Set rngFindTotal = .Cells.Find("Zirh", LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)

is

Set rngFindTotal = .Cells.Find([Range D2:D20 on worksheet "Config"], LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)

Or the equivalent of that. I'm not trying to remove rows from Range D2:D20, I'm USING that range to remove rows from a whole other Worksheet ("Config")

[AB33]

Tim,
It can be done with find function, but will do it slightly different to wend loop, but I would like to see a sample for testing.

[TimBZKK]

I'll post one tomorrow morning. The sheet itself is on my office computer.

[TimBZKK]

Here we go, this should do.

SampleBook2.xlsm

[TimBZKK]

I've solved it! I changed to an If Then, and used an array for the Remove List.

Sub FindFromRange()



    Dim rngFound As Range, rngToDelete As Range

    Dim strFirstAddress As String

    Dim varList As Variant

    Dim lngCounter As Long



    Application.ScreenUpdating = False

    

    varList = ActiveWorkbook.Sheets("Config").Range("D2:D20").Value

    

    For lngCounter = LBound(varList) To UBound(varList)

    

        With ActiveSheet.Range("A:A")

            Set rngFound = .Find(What:=varList(lngCounter, 1), LookIn:=xlValues, Lookat:=xlPart, MatchCase:=False)

                                    

            If Not rngFound Is Nothing Then

                If rngToDelete Is Nothing Then

                    Set rngToDelete = rngFound

                Else

                    Set rngToDelete = Application.Union(rngToDelete, rngFound)

                End If

                

                strFirstAddress = rngFound.Address

                Set rngFound = .FindNext(After:=rngFound)

                

                Do Until rngFound.Address = strFirstAddress

                    Set rngToDelete = Application.Union(rngToDelete, rngFound)

                    Set rngFound = .FindNext(After:=rngFound)

                Loop

            End If

        End With

    Next lngCounter

    

    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete



    Application.ScreenUpdating = True



End Sub

[AB33]

Tim,
Sorry!
I did not get back to you on time, but you have resolved it yourself.
Well done!
I was about to post very similar code, but you have got it.

[TimBZKK]

Thanks for your time anyways. You've been very helpful to me!