Excel remove rows that have certain words in a column - vba

Question

I am new to excel scripting/macroing
I have a massive excel sheet and I need to remove some rows from it.
Any rows that have the words: cat, dog, horse, fish
Have tried something like this (as well as quite a few other atempts).
Sub DeleteRows()
Dim c As Range
Dim SrchRng
Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set c = SrchRng.Find("dog","cat","horse","fish", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing
End Sub
Some details (since I am unsure what information is truely needed).
These words would always be in the 2nd column (but it could be something like "The George fish" and it would need to remove that row.
Any help would be great, thanks!

Answer 1

I have accomplished this without the help of Macros or scripts.
In the Data tab select filter, then select filter by word containing.
Enter the words, then simply delete all the rows that appear.
Answering incase anyone else has this problem in the future!

Answer 2

This works.
Sub DeleteRows()
Dim ws As Worksheet
Dim lastRow As Long
Dim lookAt As Range, thisCell As Range, nextCell As Range
Dim keyWord(0 To 3) As String, targetColumn As String
Dim i As Integer
keyWord(0) = "cat"
keyWord(1) = "dog"
keyWord(2) = "horse"
keyWord(3) = "fish"
On Error GoTo Err
Set ws = Application.ActiveSheet
'get last populated row number
With ws
If WorksheetFunction.CountA(Cells) > 0 Then
lastRow = Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
End With
'define the target column
targetColumn = "A"
Set lookAt = ActiveSheet.Range(targetColumn & "1:" & targetColumn & lastRow)
'for each item in keyWord array
For i = LBound(keyWord) To UBound(keyWord)
'look for that word throughout range
Set thisCell = lookAt.Find(what:=keyWord(i), LookIn:=xlValues, lookAt:=xlPart, SearchDirection:=xlNext)
If Not thisCell Is Nothing Then
Set nextCell = thisCell
Do
Set thisCell = lookAt.FindNext(After:=thisCell)
If Not thisCell Is Nothing Then
If InStr(1, thisCell.Text, keyWord(i)) Then
thisCell.ClearContents
End If
Else
Exit Do
End If
Loop
End If
Next i
' delete empty rows
On Error Resume Next
Range(targetColumn & "1:" & targetColumn & lastRow).Select
Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete
Err:
Exit Sub
End Sub