An excellent point worth noting.

My advise was more to demonstrate alternate looping, which the poster seemed
to struggle with.


"J.E. McGimpsey" wrote in message
...
Even better (at least in terms of speed) is eliminating all the
incremental deletions and deleting all the rows at once:

Public Sub Eliminate()
Const cFullName = 4
Dim rCell As Range
Dim rDelete As Range
With Worksheets(1)
For Each rCell In .Range(.Cells(1, cFullName), _
.Cells(.Rows.Count, cFullName).End(xlUp))
With rCell
If Instr(.Text, " COMPANY", vbTextCompare) < 0 Then
If rDelete Is Nothing Then
Set rDelete = .Cells
Else
Set rDelete = Union(rDelete, .Cells)
End If
End If
End With
Next rCell
End With
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub

or, if " COMPANY" is expected to occur rarely, do a .Find() loop.




In article ,
"Rob van Gelder" wrote:

Best to work from bottom to up so you don't have to deal with these
types of
issues.

If you must go from top to bottom, then this code should work:

Sub Eliminate()
Const cFullName = 4
Dim i As Long, j As Long

With Worksheets(1)
i = 2: j = .Cells(.Rows.Count, cFullName).End(xlUp).Row
Do Until i j
If InStr(1, .Cells(i, cFullName).Value, " COMPANY",
vbTextCompare) < 0 Then
.Rows(i).EntireRow.Delete
j = j - 1
Else
i = i + 1
End If
Loop
End With
End Sub