Inserting rows after every week

[Matt]

I have a list of consecutive dates running down column A in dd/mm/yy format. I am trying to insert 2 rows after every Sunday. My feeble attempt below completely failed, would appreciate any suggestions.

Thanks

Matt

Dim irow As Long
irow = 1

Do While Cells(irow, 2) <> ""


If Format(Range("A" & irow, "dddd")) = "Monday" Then
Selection.EntireRow.Insert
Selection.EntireRow.Insert
End If

irow = irow + 1

Loop

End Sub

[Dave Hawley]

Hi Matt


I was going to write a Loop, but you will be flooded with these soon. Here is a much quicker method.

Sub Doit()
Dim rRange As Range
Set rRange = Range("B8:B" & Range("A65536").End(xlUp).Row)

rRange.FormulaR1C1 = "=IF(AND(WEEKDAY(RC[-1])=1,R[-7]C<>1),1)"
rRange = rRange.Value
rRange.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Insert
rRange.Clear

End Sub



Just ensure Column B is empty when you run it.

[Matt]

Dave you're a legend! Cheers

[Matt]

Dave

The code works great how would I amend it to insert 2 rows instead of 1?

thanks

Matt

[Matt]

Ignore last post, have resolved

[Dave Hawley]

Oh well, better late than never.

Sub Doit()
Dim rRange As Range
Set rRange = Range("B8:B" & Range("A65536").End(xlUp).Row)

rRange.FormulaR1C1 = "=IF(AND(WEEKDAY(RC[-1])=1,R[-7]C<>1),1)"
rRange = rRange.Value

With rRange.SpecialCells(xlCellTypeConstants, xlNumbers)
.EntireRow.Insert
.EntireRow.Insert
End With

rRange.Clear

End Sub