Delete Rows based on Cell Values

[manojs1234]

Hello everyone, Below is a VB Macro I found in the internet. Basically this deletes any row in a range of cells that has the text "Apple". I would like to modify this code to delete any rows that contains "Apples" or "Oranges" or "Grapes" or "Bananas" or "Strawberries". How do I do that? Your input is greatly appreciated.

[pre]

Sub Delete_Rows()
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("A1:C20"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "Apple" Then
If del Is Nothing Then
Set del = cell
Else
Set del = Union(del, cell)
End If
End If
Next cell

On Error Resume Next
del.EntireRow.Delete
On Error GoTo 0
End Sub

[/pre]

 

[NARAYANK991]

Hi Manoj ,


Try this :

[pre]

Sub Delete_Rows()
Const WORD_LIST = "Apple|Orange|Banana|Grape|Strawberry"
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("A1:C20"), ActiveSheet.UsedRange)
For Each cell In rng
If ((cell.Value <> vbNullString) And (InStr(1, WORD_LIST, cell.Value) > 0)) Then
If del Is Nothing Then
Set del = cell
Else
Set del = Union(del, cell)
End If
End If
Next cell

On Error Resume Next
del.EntireRow.Delete
On Error GoTo 0
End Sub

[/pre]
Narayan