Insert Row based on above cell value

[mccoygs]

I want to be able to select the column that I want it to compare the value and if the value changes then insert a row. This code works but it doesn't allow me select the column I want to use and it doesn't stop at the last row that has data it continues to the end of he spreadsheet.

Sub Insert()
Dim LR Ad Long
Application.ScreenUpdating = False
LR = Range("B" & Rows.Count).End9xlUp).Row
Range("B" &LR).Select
Do Until ActiveCell.Row=2
If ActiveCel.Value<> Active.Offset(-1).Value Then
ActieCell.Resze(1).EntireRow.Insert
End If
ActiveCell.Ofse(-1).Select
Loop
Application.ScreenUpdateing - False
End Sub

 

[MARK858]

This code works

I doubt it with the typo's. Did you copy/paste the code in the thread or retype it?

Anyway try (untested)...

Sub InsertBlankRows()

    Dim LastRow As Long
    Dim i As Long
    Application.ScreenUpdating = False

    LastRow = Columns(Selection.Column).Find("*", , xlValues, , xlByRows, xlPrevious).Row

    For i = LastRow To 2 Step -1
        If Cells(i, Selection.Column) <> Cells(i - 1, Selection.Column) Then Rows(i).Insert
    Next i

    Application.ScreenUpdating = True
End Sub