change this
Do Until IsEmpty(ActiveCell)

to just
DO

"Patrick Molloy" wrote:

first, dim c as Range

the FIND function is circular, ie once its found the last item, it starts
again. Look up FIND in HELP and in the example they save the address of the
first find and loop until it gets back there again

Public Sub RowFix()

Dim c As Range
DIM addr as String
Dim FirstRow As Integer

With Worksheets(1).Range("A6:A4000")
Set c = .Find("01152", LookIn:=xlValues)
If Not c Is Nothing Then
FirstRow = c.Row + 1
Addr = C.Address
Do Until IsEmpty(ActiveCell)
c.EntireRow.Insert
c.Offset(-1, 0).Value = "Next"
Set c = .FindNext(c)
Loop Until c.Address = Addr
End If
End With

End Sub

(i haven't tested this)



"pwk" wrote:

Why won't this stop looping? Where did I go wrong. It works fine but
it goes on and on.
thanks in Advance

Public Sub RowFix()

Dim c As Variant
Dim FirstRow As Integer

With Worksheets(1).Range("A6:A4000")
Set c = .Find("01152", LookIn:=xlValues)
If Not c Is Nothing Then
FirstRow = c.Row + 1
Do Until IsEmpty(ActiveCell)
c.EntireRow.Insert
c.Offset(-1, 0).Value = "Next"
Set c = .FindNext(c)
Loop
End If
End With

End Sub