Adding a blank line above a row with a non-blank cell

[laniw75]

I need some more vba expertise.

I need a blank row inserted above any non-blank cell in column A.

Can anyone please advise?

Thanks

 

[rudfaden]

This macro should do it. But note that if you do entire column A it will take some time

Sub InsertRow()
Dim i As Long

For i = 1 To 5 'insert all the row you want.
    If Len(Cells(i, 1).Value) = 0 Then
        Cells(i, 1).EntireRow.Insert shift:=xlUp 'Inserts row above
        i = i + 1 'skip to next row
    End If
Next i

End Sub

 

[rudfaden]

You may wanna add

application.screenupdating=false
application.screenupdating=true

aroudn the code to speed things up

 

[laniw75]

Hi again,

It appears to be adding a line above the blank cells, I need it to add a line above the non-blank cell.

Thanks

 

[rudfaden]

Try this:

application.screenupdating=false

Sub InsertRow()
Dim i As Long

For i = 1 To 5 'insert all the row you want.
    If Len(Cells(i, 1).Value) = 0 Then
        Cells(i, 1).EntireRow.Insert shift:=xlDown 'Inserts row above
        i = i + 1 'skip to next row
    End If
Next i

application.screenupdating=true
End Sub

 

[Peter_SSs]

If you are looping through the rows to add, it's best to work from bottom to top. Try ..

Sub Insert_Rows()
    Dim LR As Long, r As Long
    
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    For r = LR To 1 Step -1
        If Len(Range("A" & r).Value) > 0 Then
            Rows(r).Insert
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

 

[laniw75]

Your VBA worked like a dream, thanks Peter!

Any chance we can enter code to turn the row yellow?

 

[Peter_SSs]

Any chance we can enter code to turn the row yellow?

Sure, but do you mean the newly inserted blank one or the one with the non-blank value in column A?

 

[laniw75]

the newly inserted blank line (it becomes a sub total row)!

Thanks

 

[Peter_SSs]

the newly inserted blank line

Add the blue line of code

    Rows(r).Insert
    Rows(r).Interior.ColorIndex = 27
End If