A Loop in a Loop

[John8669]

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

[Simon Lloyd]

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]

[John8669]

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

[Simon Lloyd]

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!

[John8669]

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

[Bob Phillips]

[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]

[John8669]

Perfect!!! Thanks

[Simon Lloyd]

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.