当下面的单元格值不等于活动单元格值时如何插入新行

Question

How to insert new row when cell value below does not equal to active cell value

simply how to get this result:

currently the vba code is:

Sub InsertBlankRowsBasedOnCellValue()

Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

    Col = "A"
    StartRow = 1
    BlankRows = 1

        LastRow = Cells(Rows.Count, Col).End(xlUp).Row

        Application.ScreenUpdating = False

        With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) <> LastRow Then
.Cells(R, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
Application.ScreenUpdating = True

End Sub

Answer 1

The condition

If .Cells(R, Col) <> LastRow Then

mixes cell values and row numbers oddly.

There you should just check if you are at the last low. Then you can't compare it to anything yet, use the following condition to skip that case:

If R <> LastRow Then

For all the other rows you should compare the two consecutive cell values

If .Cells(R, Col).Value <> .Cells(R + 1, Col).Value Then

So here is the whole code:

Dim Col As Variant
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

Col = "A"
StartRow = 1

LastRow = Cells(Rows.Count, Col).End(xlUp).Row
With ActiveSheet
    Application.ScreenUpdating = False
    For R = LastRow To StartRow + 1 Step -1
        If R <> LastRow Then
            If .Cells(R, Col).Value <> .Cells(R + 1, Col).Value Then
                .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
            End If
        End If
    Next R
End With
Application.ScreenUpdating = True

End Sub