Sorry, i fibbed, your do loop is causing the problem, what are you trying to
accomplish?
--
-John Northwest11
Please rate when your question is answered to help us and others know what
is helpful.


"shorticake" wrote:

I'm having difficulty getting this macro to loop. I keep getting the run
time error 1004, or the macro will continue to insert rows until it reaches
the last available row in the sheet.

Any help or suggestions are greatly appreciated.

Dim i As Integer
Dim Rng As Range
Dim lFirstRow As Long
With ActiveSheet.Range("B:B")

Dim findstring As String
findstring = "200611"

Set Rng = Range("B:B").Find(What:=findstring, After:=Range("B" &
Rows.Count), LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
lFirstRow = Rng.Row
Do
With Rng.Offset(1, 0)
For i = 1 To 1
.EntireRow.Insert xlShiftDown
Next i
End With
Set Rng = .FindNext(Rng)

Loop While Not Rng Is Nothing

End If
End With

End Sub