Quick Search Loop

[Sami82]

Hi All,

I am trying to write a loop (which is part of a larger macro) that
searches a worksheet and deletes the rows which contains the search
text.

Do
Cells.Find(What:="Vendor Item", After:=ActiveCell,
LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
'if activecell does contain "Vendor Item" then
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(1,
0)).Delete Shift:=xlUp
ActiveCell.Offset(1, 0).Activate
'end if
Loop Until IsEmpty(ActiveCell)

It does this successfully until there are no more of the search strings
in the document, then it starts deleting any rows. (There is more data
on the row which has vendor item). I realise i could put coding in, but
I dont know how to proceed. Please help

Thank you

 

[Tom Ogilvy]

Sub ABC()
Dim rng As Range
Set rng = Cells.Find(What:="Vendor Item", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rng Is Nothing Then
Do
sAddr = rng.Address
rng.Resize(2).Delete Shift:=xlUp
Set rng = Range(sAddr)
Set rng = Cells.FindNext(rng)
Loop While Not rng Is Nothing
End If

End Sub