Q:

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

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

A:

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

