Trying to Loop the below macro until foundcell is nothing, any ideas?

Range("A1").Select

Dim FoundCell As Range
With Worksheets("StockSheet")

Range("A1").Select

Set FoundCell = .Cells.Find(What:="BOO", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If FoundCell Is Nothing Then

Else

FoundCell.EntireRow.Delete
End If

End With