Add Row Above Date

[AdamDN]

I am working on schedules and want to add blank rows to each schedule for any changes that need to be annotated. So I want to add 2 blank rows above any date that I find (except the first date because we're not scheduling for the past)). I have typed and retyped 5 or 6 different ways and I am puzzled. Here is what I have, but it keeps adding ~130 rows after the second date and will not add rows above any other date. Also, I would like to delete the two rows that auto-generate below each date (haven't worked on that one yet because I can't even get this far)>

Sub InsertRowsAboveDate()

With Range("A:A")

Dim LR As Long
Dim r As Long

LR = Cells(Rows.Count, "A").End(xlUp).Row

For r = 2 To LR
If IsDate(Cells(r, "A")) Then
Rows(r).Insert
End If

Next r

End With

End Sub

 

[JEC]

Try to loop from bottom to top. Not knowing how your data looks like:

LR = Cells(Rows.Count, "A").End(xlUp).Row
For r = LR to 2 step - 1
  If IsDate(Cells(r, "A")) Then  Rows(r).Insert xldown
Next

 

[AdamDN]

Try to loop from bottom to top. Not knowing how your data looks like:

LR = Cells(Rows.Count, "A").End(xlUp).Row
For r = LR to 2 step - 1
  If IsDate(Cells(r, "A")) Then  Rows(r).Insert xldown
Next

Right on man! Works perfect. Just have to work on deleting the rows beneath. I'll reach out if I have trouble. Thank you again.