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:

Name	Start Time	End Time	Location	Area
James	0800	0830	a	c
Margaret	0800	0815	a	c
Name	Start Time	End Time	Location	Area
Francis	0900	0930	a	d
Herbert	0900	0930	a	c
Name	Start Time	End Time	Location	Area
Willie	1000	1030	a	c
Ann	1000	1015	a	c
Annie	1000	1045	a	d
Name	Start Time	End Time	Location	Area
Kathy	1300	1330	a	d
Cathy	1300	1315	a	d
Name	Start Time	End Time	Location	Area
Peggy	1315	1330	a	c

<tbody>
</tbody>

​

 

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