Insert a blank row after change in data

[Guest]

I have a spreadsheet with 300 rows of data and I need a macro that will
insert a blank row after a change in the data in column B. The data starts
in row 10. Thanks for your help.

 

[Guest]

Came across a sub below by a poster in .programming
Modified a little to end at row 10 to suit.
Try it on a spare copy ..

Sub InsertRow_At_Change()
Dim i As Long
With Application
.Calculation = xlManual
.ScreenUpdating = False
End With
For i = Cells(Rows.Count, 2).End(xlUp).Row To 10 Step -1
If Cells(i - 1, 2) <> Cells(i, 2) Then _
Cells(i, 1).Resize(1, 1).EntireRow.Insert
Next i
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub

 

[Mike @ GD]

Max,

This works well however the formating of the existing rows is not carried
over to the new row. Can this be done, I am using Vlookup and data validation
in exsisting rows.

 

[Per Jessen]

Hello

Assuming row 10 has the desired formatting and all rows to the new
last row in column B shall have this formatting, this should do it:

Sub InsertRow_At_Change()
Dim i As Long
Dim LastRow As Long
With Application
.Calculation = xlManual
.ScreenUpdating = False
End With
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = LastRow To 10 Step -1
If Cells(i - 1, 2) <> Cells(i, 2) Then _
Cells(i, 1).Resize(1, 1).EntireRow.Insert
Next i
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
Rows("10").Copy
Rows("10:" & LastRow).PasteSpecial Paste:=xlFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub

Regards,
Per