Insert rows condition but ingore the blank cells.

[Shazam]

Hi Everyone,


I have this code below that it will insert a row in column A if there is a text name "Total". But I would like to add a condition. If the text "Total" has a blank cell underneath do not insert row.



[vba]
Sub Test()
Range("A65536").End(xlUp).Offset(-2, 0).Select
Do Until ActiveCell.Row = 1
If Right(ActiveCell, 5) = "Total" Then
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0)).EntireRow.Insert
ActiveCell.Offset(-1, 0).Select
Else
ActiveCell.Offset(-1, 0).Select
End If
Loop

End Sub
[/vba]



I tried to modify it like this but no avail.


[vba]
Sub Test()
Range("A65536").End(xlUp).Offset(-2, 0).Select
Do Until ActiveCell.Row = 1
If Right(ActiveCell, 5) = "Total"
If <>"" Then
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0)).EntireRow.Insert
ActiveCell.Offset(-1, 0).Select
Else
ActiveCell.Offset(-1, 0).Select
End If
Loop

End Sub
[/vba]

I left an example workbook below.

[MaximS]

try this:

[VBA]Sub Test()
Range("A65536").End(xlUp).Offset(-2, 0).Select
Do Until ActiveCell.Row = 1
If Right(ActiveCell, 5) = "Total" And ActiveCell.Offset(1, 0) <> "" Then
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0)).EntireRow.Insert
ActiveCell.Offset(-1, 0).Select
Else
ActiveCell.Offset(-1, 0).Select
End If
Loop
End Sub[/VBA]

[Shazam]

try this:

[vba]Sub Test()
Range("A65536").End(xlUp).Offset(-2, 0).Select
Do Until ActiveCell.Row = 1
If Right(ActiveCell, 5) = "Total" And ActiveCell.Offset(1, 0) <> "" Then
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0)).EntireRow.Insert
ActiveCell.Offset(-1, 0).Select
Else
ActiveCell.Offset(-1, 0).Select
End If
Loop
End Sub[/vba]

Perfect!!! Thank You.