Check if consecutive rows have identical value, if not insert new row between them-CodePudding

i am looking for a solution to my problem. The task is to compare two consecutive rows with each other,in the range from column D1 to the last written cell in Column D. If the value of a consecutive cell is equal to the value of the previous cell , i.e. D2=D1, the macro can go next, else it shall insert a new row between the two values. Since i am fairly new to vba and mostly use information based on online research, i could not find a fitting solution til now. Below you can see a part of what tried.

Sub Macro()

 'check rows
 
Dim a As Long
Dim b As Long, c As Long

a = Cells(Rows.Count, "D").End(xlUp).Row
For b = a To 2 Step -1
    c = b - 1

    If Cells(b, 4).Value = Cells(c, 4).Value Then
     If Cells(b, 4).Value <> Cells(c, 4).Value Then
    Rows("c").Select
    Selection.Insert Shift:=xlDown
    
     End If
      
      End If
    
Next b
    
End Sub

CodePudding user response：

Sub InsertRows()
    Dim cl As Range
    With ActiveSheet
        Set cl = .Cells(.Rows.Count, "D").End(xlUp)
        Do Until cl.Row < 2
            Set cl = cl.Offset(-1)
            If cl.Value <> cl.Offset(1).Value Then cl.Offset(1).EntireRow.Insert
        Loop
    End With
End Sub

Side note. You can benefit from reading