Hi agentred
try
Option Explicit
Sub ptest()
Dim a#, i#
 a = Range("a" & Rows.Count).End(xlUp).Row - 1  '.Resize(, 1)
           For i = a - 1 To 1 Step -1
                      If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
           Cells(i + 1, 1).Insert Shift:=xlDown
            End If
               Next
       End Sub