Sub yty()
Dim FoundCell As Range
Dim rng As Range
Dim sFirst As String

Range("A1").Select

With Worksheets("StockSheet")

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

If Not FoundCell Is Nothing Then
sFirst = FoundCell.Address
Set rng = FoundCell

Do
Set FoundCell = .FindNext(FoundCell)
If Not FoundCell Is Nothing Then
Set rng = Union(rng, FoundCell)
End If
Loop While Not FoundCell Is Nothing And FoundCell.Address <
sFirst

End If

If Not rng Is Nothing Then rng.EntireRow.Delete

End With

End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Heather O'Malley" wrote in message
. ..
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