Hello msmick,
Welcome to the Forum!
This macro will do what you asked for.
Sub MarkChanges()
Dim Cnt As Long
Dim Data As Variant
Dim Headers As Variant
Dim I As Long
Dim N As Long
Dim R As Long
Dim Rng As Range
Dim RngEnd As Range
Dim Wks As Worksheet
Set Wks = ActiveSheet
Set Rng = Wks.Range("A1")
Set RngEnd = Wks.Cells(1, Columns.Count).End(xlToLeft)
Set Rng = Wks.Range(Rng, RngEnd)
Headers = Rng.Rows(1).Cells.Value
Set RngEnd = Wks.Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False)
Set Rng = Rng.Resize(RngEnd.Row, UBound(Headers, 2))
Data = Rng.Columns(3).Cells.Value
R = Rng.Row + 1
For I = 2 To UBound(Data) - 1
Cnt = Cnt + 1
If Data(I + 1, 1) = "" Then Exit Sub
If Data(I, 1) <> Data(I + 1, 1) Then
R = R + Cnt
Wks.Rows(R).EntireRow.Insert
Wks.Rows(R).Resize(1, UBound(Headers, 2)).Value = Headers
Cnt = 0
R = R + 1
End If
Next I
End Sub
Bookmarks