Add new row when cell value changes - vba

Question

I need to add a new row whenever a cell values changes in a defined column. I then need it to do the same for another column, then another column after that.
I used the same code three times, with different columns referenced, but I think it is not working due to the new (blank) rows entered from the first run. I've written it as three separate Subs.
Sub LineTestCODE()
Dim lRow As Long
For lRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row To 2 Step -1
If Cells(lRow, "C") <> Cells(lRow - 1, "C") Then Rows(lRow).EntireRow.Insert
Next lRow
End Sub
Sub LineTestENHANCEMENT()
Dim lRow2 As Long
For lRow2 = Cells(Cells.Rows.Count, "D").End(xlUp).Row To 2 Step -1
If Cells(lRow2, "D") <> Cells(lRow2 - 1, "D") Then Rows(lRow2).EntireRow.Insert
Next lRow2
End Sub
Sub LineTestZONE()
Dim lRow3 As Long
For lRow3 = Cells(Cells.Rows.Count, "G").End(xlUp).Row To 2 Step -1
If Cells(lRow3, "G") <> Cells(lRow3 - 1, "G") Then Rows(lRow3).EntireRow.Insert
Next lRow3
End Sub

Answer 1

I'm not exactly sure how you want to add your rows. It looks as if you want to test the changed cell and if it doesn't match the cell above add a row. I guess it's also possible that you want to add one row per unmatching cell pair in your columns. You'll see both in the code below - take your pick.
I put this code in the Sheet_Change event but you could put it in a module and call it from this event if you wished. You'll see I've disabled events, this could be the problem with your code.
This routine doesn't test if someone pasted values (ie Target.Cells.Count > 1). You might want to handle the possibility of Target being multiple cells.
For Each item in Target.Cells
..//..
Next
could work for you.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyColumns As Range
' Define the value columns we're interested in
If MyColumns Is Nothing Then
Set MyColumns = Union(Columns("C"), _
Columns("D"), _
Columns("G"))
End If
' If you just want to add one row for a non-matching change in one of the three columns changes
If Not Intersect(Target, MyColumns) Is Nothing Then
If Target.Row > 1 Then
If Target.Offset(-1).Value <> Target.Value Then
Application.EnableEvents = False
Target.Offset(1).EntireRow.Insert
Application.EnableEvents = True
End If
End If
End If
' If you want to add one row for each non-matching cell value in the three columns
Dim cell As Range
If Not Intersect(Target, MyColumns) Is Nothing Then
If Target.Row > 1 Then
For Each cell In Intersect(MyColumns, Target.EntireRow).Cells
If cell.Offset(-1).Value <> cell.Value Then
Application.EnableEvents = False
cell.Offset(1).EntireRow.Insert
Application.EnableEvents = True
End If
Next
End If
End If
End Sub