Insert row below based on cell value

Question

I found a macro at Insert copied row based on cell value.

The macro inserts a blank row above any row that has a value of "0" in column E.

Instead of the empty row appearing above, I need it to appear below.

Sub BlankLine()

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

    Col = "E"
    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) = "0" Then
                .Cells(R, Col).EntireRow.Insert Shift:=xlDown
            End If
        Next R
    End With

    Application.ScreenUpdating = True

End Sub

Steven Nelms Steven Nelms · Accepted Answer · 2014-10-01T15:40:22

Edit the following line from:

.Cells(R, Col).EntireRow.Insert Shift:=xlDown

to:

.Cells(R+1, Col).EntireRow.Insert Shift:=xlDown

Insert row below based on cell value

2 Answers