Insert Rows using VBA

[Tony]

I am using the following code to try and find a "1" in column "R". Whenever I
find one I want to insert a row. With the code I have here I find the "1" in
row "4" but it inserts a row at row "48", then row "50, etc. What do I need
to do to insert a row at rows "4", "15",


LoopCol2 = 1
LoopRow2 = 4

While Not IsEmpty(Worksheets("Break & Lunch Schedule").Cells(Looprow2,
LoopCol2))etcf.
With wsPh
If wsPh.Range("r" & Looprow2 + 0) = 1 Then wsPh.Range("r"
& Looprow2).End(xlDown).Select
Selection.EntireRow.Insert
Looprow2 = Looprow2 + 1
' ETop = ETop + 1
Else
Looprow2 = Looprow2 + 1
' ETop = ETop + 1
End If
End With
Wend

 

[Mike H]

Tony,

Maybe a slightly different approach

Sub insert_row()
Sht = "Break & Lunch Schedule"
lastrow = Sheets(Sht).Cells(Rows.Count, "R").End(xlUp).Row
For x = lastrow To 1 Step -1
If Sheets(Sht).Cells(x, 18) = 1 Then
Sheets(Sht).Rows(x).EntireRow.Insert
End If
Next
End Sub


Mike

 

[Tony]

Mike, that did the trick. Thanks. One more thing I want to add colour to the
blank lines. Where would I put the following code to do that?

.Interior.ColorIndex = 1