Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo do_nothing
If Not Intersect(Range("G:G"), Target) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
If Target.Interior.Color <> Target.Offset(1, 0).Interior.Color Or _
Target.Borders(xlEdgeRight).LineStyle <> Target.Offset(1, 0).Borders(xlEdgeRight).LineStyle Then
Rows(Target.Row + 1).Insert Shift:=xlDown
Rows(Target.Row).Copy Rows(Target.Row).Offset(1, 0)
Rows(Target.Row + 1).ClearContents
Rows(Target.Row + 1).Cells(1, 1).Value = Date
End If
Else
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
do_nothing:
End Sub
Let us know if it works for you
Open in new window