Help With Insert Row Macro

[ksp]

I need some help with a macro to insert one row at a point where there is text in a particular column.

The worksheet has multiple columns, but the two relevant ones are headed Category (Column A) and Tasks (Column D). Each Category description has at least one task, but can have up to 20. I have been using the macro below to insert one row before each new category. However, what I have discovered is that this is actual inserting one row after the category description. This is fine as long as there is only ever one task, but this is not the case.

Everything that I have tried so far seems to only cause the macro to go into a loop

Any input / help would be appreciated

Thanks

Karen

Sub InsertRows()
With Range("A10:A2498")
On Error Resume Next
Set C = .Find(What:="*", LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.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

[Anita]

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

[ksp]

Hi Anita

It sort of worked. I am no longer getting the endless loop, but I suspect that it is still looping as it is now inserting 6 rows between each - any ideas why?

Thanks

Karen

[ksp]

Hi Anita

Thought you might like to know that I played around with the changes you suggested (see below) and it now works perfectly - thanks heaps for your input

Karen


Sub InsertRows()
With Range("A10:A2499")
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(0, 0).EntireRow.Insert
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstaddress
End If

End With

End Sub

[Anita]

Oops. On inserting the row I was using -1 rows when I shouldn't have
been offsetting it at all. Here's the Do Loop with a change to line 2.

Do
c.EntireRow.Insert
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address > firstaddress

[Anita]

Thanks so much for letting me know that it worked out for you!

Anita