Try this
![]()
Option Explicit Sub x() Dim rRng As Range Dim Rw As Long With Sheet1 Set rRng = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) For Rw = rRng.Rows.Count To 1 Step -1 If Rw = 1 Then Exit For If .Cells(Rw, 1).Value <> .Cells(Rw - 1, 1).Value Then .Cells(Rw, 1).EntireRow.Insert With .Cells(Rw, 1).Interior .ColorIndex = 33 .Pattern = xlSolid End With End If Next Rw End With End Sub
Bookmarks