Help! Inserting Rows
 

I'm using the following code to insert rows into a spreadsheet. It
has worked just fine. Once the Do Until ActiveCell.Value finds a
value that does not match, it inserts a row between those values
(example below). The problem is the spreadsheet keeps growing the
macro works until it reaches a certain point, around row 2000 then I
receive an error and Excel closes down. Does anyone have any
suggestions as to how I can get around this. Thanks for any help.
Juls

SYJ12345
SYJ12345
(inserts row)
SYJ45678
SYJ45678

Sub Insert_Rows()

Range("G10").Select

Do Until ActiveCell.Value = ""
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.Offset(1, 0).Select
Else:
Selection.EntireRow.Insert
ActiveCell.Offset(2, 0).Select

End If
Loop
End Sub

Help! Inserting Rows
 

Code worked fine for me processing 5000 cells, adding over 3500 rows.

It stopped on Row 8751 when it found a blank cell.

xl2000, SR1, US English, Win 2K.

--
Regards,
Tom Ogilvy


"JulsMarie" wrote in message
om...
I'm using the following code to insert rows into a spreadsheet. It
has worked just fine. Once the Do Until ActiveCell.Value finds a
value that does not match, it inserts a row between those values
(example below). The problem is the spreadsheet keeps growing the
macro works until it reaches a certain point, around row 2000 then I
receive an error and Excel closes down. Does anyone have any
suggestions as to how I can get around this. Thanks for any help.
Juls

SYJ12345
SYJ12345
(inserts row)
SYJ45678
SYJ45678

Sub Insert_Rows()

Range("G10").Select

Do Until ActiveCell.Value = ""
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.Offset(1, 0).Select
Else:
Selection.EntireRow.Insert
ActiveCell.Offset(2, 0).Select

End If
Loop
End Sub