Search for data from list and delete row - excel

Question

I have a table in Sheet1. I need to search in Sheet1 for terms in Sheet2-ColumnA.
The exclusion list in Sheet2-ColumnA does not match the cell contents in Sheet1, but is found within the cell contents (Ex: find "orange" in "yellow;orange" or "orange;yellow").
If that criteria is found, delete the row. If it doesn't find the criteria, continue on down the list until it reaches an empty cell.
I recorded one round of this, but I need to modify it to loop through the entire exclusion list until it reaches an empty cell in the exclusion list.
Sub ExclusionList()
'
' ExclusionList Macro
' Find terms from exclusion list and delete row
'
' Go to sheet2 and select first term in exclusion list
Sheets("Sheet2").Select
Range("A1").Select
' Copy cell contents and find in sheet 1
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Cells.Find(What:="orange", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
' Delete row if found
Application.CutCopyMode = False
Selection.EntireRow.Delete
End Sub
In this example, "orange" is the criteria in Sheet2 A1. If it is possible to skip the copy/paste and refer directly to the exclusion list in the Cells.Find() function it seems like that would clean up the code and be more efficient overall.

Answer 1

Try this.
Here is a useful resource on avoiding Select/Activate. This shortens code considerably and makes it more effective.
Sub ExclusionList()
Dim r As Range, rFind As Range
With Sheets("Sheet2")
For Each r In .Range("A1", .Range("A" & Rows.Count).End(xlUp)) 'loop through every cell in sheet2 column A
Set rFind = Sheets("Sheet1").Cells.Find(What:=r.Value, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then 'check that value is found to avoid error on next line
rFind.EntireRow.Delete
End If
Next r
End With
End Sub