Insert cells after row value changes

[mr_mango81]

I'm after code to add two rows of cells but only 6 columns wide every time a value changes in a columns. e.g.
before;
1
1
1
2
2
3
3
3
3

after;
1
1
1
(insert two rows, 6 columns wide here)
2
2
(insert two rows, 6 columns wide here)
3
3
3
3
(insert two rows, 6 columns wide here)

This is the code i have so far;

Sub InsertBlankRows()

Dim LastRow As Long
Dim i As Long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = LastRow To 2 Step -1
If i = 2 Then
'Do nothing
ElseIf Cells(i, "A") <> Cells(i - 1, "A") Then
Cells(i, "A").Insert
End If
Next i

End Sub

This code inserts one cell below each of the values when they change but one column only

help would be greatly appreciated.

[:) Sixthsense :)]

May be this...

Please Login or Register  to view this content.

[mr_mango81]

That works for the insertion of two rows, but I only need two new rows in columns A:F as I have other data in the next columns. Any ideas?

[:) Sixthsense :)]

Try this...

Please Login or Register  to view this content.

[mr_mango81]

Works Beautifully! My data doesn't start until row three, Is there a way I can get it to stop at row three so It doesn't insert cells below the column header row. I have a title in row one and then column headers in row two.

[:) Sixthsense :)]

Glad it helps you and thanks for the feedback

Just change the start row here...

Please Login or Register  to view this content.

[mr_mango81]

Thankyou heaps SixthSence, this now works a treat!!