Insert blank rows when field value changes

[Rackette]

Thank you to anyone who can help me.

I need to insert 4 blank rows every time there is a value change in column B.
AND, if you're feeling happy, I'd actually like to insert 5 rows...4 blank ones and the 5th being a copy of the header row.
The copy of the header row needs to be exact..same font, same shading, same everything.

I copied this from a different thread but this inserts one blank row. I need 4 blank rows plus a copy of the header row.

Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 3 Step -1
If Range("B" & i).Value <> Range("B" & i - 1).Value Then Rows(i).Insert
Next i
End Sub

This is what I'd end with:

[TABLE="class: grid, width: 20, align: left"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD]Location[/TD]
[TD]Area[/TD]
[/TR]
[TR]
[TD]James
[/TD]
[TD]0800[/TD]
[TD]0830[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]c[/TD]
[/TR]
[TR]
[TD]Margaret[/TD]
[TD]0800[/TD]
[TD]0815[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]c[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD]Name[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD="align: center"]Location[/TD]
[TD="align: center"]Area[/TD]
[/TR]
[TR]
[TD]Francis[/TD]
[TD]0900[/TD]
[TD]0930[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]d[/TD]
[/TR]
[TR]
[TD]Herbert[/TD]
[TD]0900[/TD]
[TD]0930[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]c[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD]Name[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD="align: center"]Location[/TD]
[TD="align: center"]Area[/TD]
[/TR]
[TR]
[TD]Willie[/TD]
[TD]1000[/TD]
[TD]1030[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]c[/TD]
[/TR]
[TR]
[TD]Ann[/TD]
[TD]1000[/TD]
[TD]1015[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]c[/TD]
[/TR]
[TR]
[TD]Annie[/TD]
[TD]1000[/TD]
[TD]1045[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]d[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD]Name[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD="align: center"]Location[/TD]
[TD="align: center"]Area[/TD]
[/TR]
[TR]
[TD]Kathy[/TD]
[TD]1300[/TD]
[TD]1330[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]d[/TD]
[/TR]
[TR]
[TD]Cathy[/TD]
[TD]1300[/TD]
[TD]1315[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]d[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD]Name[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD="align: center"]Location[/TD]
[TD="align: center"]Area[/TD]
[/TR]
[TR]
[TD]Peggy[/TD]
[TD]1315[/TD]
[TD]1330[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]c[/TD]
[/TR]
</tbody>[/TABLE]

​

 

[Peter_SSs]

Try

Sub Insert_Rows()
  Dim LR As Long, i As Long
  
  Application.ScreenUpdating = False
  LR = Range("A" & Rows.Count).End(xlUp).Row
  For i = LR To 3 Step -1
    If Range("B" & i).Value <> Range("B" & i - 1).Value Then
      Rows(i).Resize(5).Insert
      Rows(i + 4).Resize(, 4).Value = Range("A1:E1").Value
    End If
  Next i
  Application.ScreenUpdating = True
End Sub

 

[Rackette]

Thank you so much, Peter.
I KNOW that had probably already been asked, but I couldn't find the thread anywhere.

I appreciate the time you take to stop in here and help us.
-Christine

 

[Peter_SSs]

You are very welcome. Glad it worked for you. Thanks for letting us know.