Insert Missing Date VBA Question

[Netsurfr]

This VBA code inserts missing dates in column A which works when the month does not start with the 1st. When the month does start with the first I get the following duplication. What am I missing to prevent this? Thank you in advance for your help.

Sub Insert_Days()
Dim r As Long, d As Date
r = 2 'start row
EOM = DateSerial(Year(Range("A" & r)), Month(Range("A" & r)) + 1, 0) 'End of month
d = DateSerial(Year(Range("A" & r)), Month(Range("A" & r)), 1) 'Beginning of month
Application.ScreenUpdating = False
Do While d <= EOM
DoEvents
If Range("A" & r) > d Then
Rows(r).Insert
Range("A" & r).Value = d
d = d + 1
ElseIf Range("A" & r) = "" Then
Range("A" & r).Value = d
d = d + 1
End If
r = r + 1
If Range("A" & r) = d Then d = d + 1
Loop
Application.ScreenUpdating = True
End Sub

 

[Joe4]

Try flipping the order of these two lines:

r = r + 1
If Range("A" & r) = d Then d = d + 1

so its:

If Range("A" & r) = d Then d = d + 1
r = r + 1

 

[Netsurfr]

Try flipping the order of these two lines:

r = r + 1
If Range("A" & r) = d Then d = d + 1

so its:

If Range("A" & r) = d Then d = d + 1
r = r + 1

Yes, it works perfectly now! Thank you very much it was causing me so much distress.

 

[Joe4]

You are welcome.