Hi Karen,

The reason you were getting stuck in the loop is the loop while check
was looking for something in the firstAddress in which you found text.
But once you found it the first time, you shift it down, so the loop
will never find anything in that cell again. Try the following:

Sub InsertRows()
With Range("A10:A2498")
On Error Resume Next
Set C = .Find(What:="*", LookIn:=xlValues)
If Not C Is Nothing Then
firstaddress = C.Offset(1, 0).Address
Do
C.Offset(-1, 0).EntireRow.Insert
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address firstaddress
End If
End With
End Sub

Hope this works for you,
Anita