Date question - really simple but I am stumped

[shhhhh]

Very sorry seem to be stuck on something simple
below is my current working code. I have a sheet where i need to account for a 2 week (15 day) period. Not everybody has times for every day but some do. What the below code doesn't account for is if the last date is missing and I can't seem to come up with a working resolution to it.

Any assistance is gratefully accepted.
Thanks.

Sub Step7_Insert_Missing_Dates()
Dim r, r2 As Long
Dim count, count2 As Integer

For count = 1 To 8
For r = Cells(65536, "a").End(xlUp).Row To 3 Step -1
If IsDate(Cells(r, "a")) Then
If IsDate(Cells(r - 1, "a")) Then
If Cells(r, "a") <> "" And ((Cells(r, "a") - Cells(r - 1, "a")) > 1) Then
Rows(r).EntireRow.Insert
Cells(r, "a") = (Cells(r + 1, "a") - 1)
End If
End If
End If
Next r
Next count
End Sub


--------------= Posted using GrabIt =----------------
------= Binary Usenet downloading made easy =---------
-= Get GrabIt for free from http://www.shemes.com/ =-

 

[Nigel]

I do not fully understand what you are trying to achieve? What is the "last
date"? As I see it you have a column of dates, if the date immediately
above is more than 1 day apart then add a new row and insert the intervening
date, do this loop 8 times to fill intervening dates.

Your code could be made simpler, but I am not sure where the problem is?

Sub Step7_Insert_Missing_Dates()
Dim r, r2 As Long
Dim count, count2 As Integer
For count = 1 To 8
For r = Cells(65536, "a").End(xlUp).Row To 3 Step -1
If IsDate(Cells(r, "a")) And IsDate(Cells(r - 1, "a")) Then
If Cells(r, "a") - Cells(r - 1, "a") > 1 Then
Rows(r).EntireRow.Insert
Cells(r, "a") = (Cells(r + 1, "a") - 1)
End If
End If
Next r
Next count
End Sub