A Loop in a Loop

I am trying to loop through a single column (A) of data until I find a Blank cell .

Inside that loop I am wanting to insert a new row when the value of the Active cell is Not equal to the value of the cell above it and then continue the first loop.

Thanks

This should do what you want[VBA]Sub InsRow_UntilBlank()
Dim Rng As Range, MyCell As Range
Set Rng = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row + 1)
For Each MyCell In Rng
If MyCell.Value = "" Then Exit Sub
If MyCell.Value <> MyCell.Offset(-1, 0).Value Then
With Range(MyCell.Address)
.Insert
End With
End If
Next
End Sub[/VBA]

Thanks Simon...But this gives an infinite loop after finding the first non-matching cell...any idea why???

Ah! yes because it is inserting a blank row which is not equal value to the one above so performs the insert again!

[VBA]

Sub InsRow_UntilBlank()
Dim Rng As Range, MyCell As Range
Set Rng = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row + 1)
For Each MyCell In Rng
If MyCell.Value = "" Then GoTo Nxt
If MyCell.Value <> MyCell.Offset(-1, 0).Value Then
With Range(MyCell.Address)
.Insert
End With
End If
Nxt:
Next
End Sub

[/VBA]try this untested!

Thanks....Same inifinite loop...It is inserting cells instead of rows and goes into Loop d' Loop

[vba]

Sub InsRow_UntilBlank()
Dim LastRow As Long
Dim i As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1

If .Cells(i, "A").Value <> .Cells(i - 1, "A").Value Then

.Rows(i).Insert
End If
Next
End With
End Sub
[/vba]

Perfect!!! Thanks

My apologies, for a couple of things, 1 i didn't test either of my offerings and 2 as xld will no doubt bend my ear on later, i didn't design the code to perform from the last row up, performing the action from row 1 down is prone to giving false results.