Insert rows where dates are missing

[WillUK]

Hi There. I have data with date ranges, but there are missing dates and need all dates to be included in the file output e.g.

In this example, I need to create rows above the 8th of July (Column C) to add 1st to 7th of July.
It also needs to replace the information in row 2, for Columns A,B,D and E when inserting the rows above.
This will only be when the first record (in row 2) does not equal the 1st of the month.

So, basically, I need the code to validate if C2 is the 1st of the month, and if not, insert the number of rows required to let row 2 equal the 1st of the month.

I managed to solve inserting rows below e.g. adding 9 and 10 July as additional rows BETWEEN rows 2 and 3 using this code :

Dim x as long
Dim MyColumn as String
Dim LastRow as Long

MyColumn = "c"
For x = Cells(Rows.Count, MyColumn).End(xlUp).Row To 3 Step -1
diff = Cells(x, MyColumn) - Cells(x - 1, MyColumn)
If diff > 1 Then
Rows(x).Resize(diff - 1).Insert
End If
Next x
LastRow = Cells(Cells.Rows.Count, MyColumn).End(xlUp).Row
For Each Area In Range(MyColumn & "3:" & MyColumn & LastRow).SpecialCells(xlCellTypeBlanks).Areas
Area(1).Offset(-1).AutoFill Destination:=Range(Area(1).Offset(-1).Resize(Area.Rows.Count + 1).Address)
Next

Any help will be appreciated.

Thanks

 

[rollis13]

Have a try with this macro, it will add the missing dates but will not fill in these rows since I can't realize what data they are to be filled with:

Option Explicit
Sub InsertMissingDates()
    Dim LastRow     As Long                       'last row
    Dim Diff   As String                          'difference between dates
    Dim x      As Long                            'loop counter
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    LastRow = Cells(Rows.Count, "C").End(xlUp).Row 'find last row in column C
    For x = LastRow To 3 Step -1                  'back-up from bottom to row 3 since we have header in row 1
        Diff = Range("C" & x) - Range("C" & x - 1) 'calculate difference from cell above
        If Diff > 1 Then                          'procede if more than a day
            Range("A" & x).EntireRow.Insert       'insert a blank row
            Range("C" & x) = Range("C" & x + 1) - 1 'add new date in column C
            If Range("C" & x - 1) < Range("C" & x) Then x = x + 1 'repeat the check in case of consecutive missing dates
        End If
    Next
    Do Until Day(Range("C2")) = 1                 'if it's not the first of the month
        Range("A" & 2).EntireRow.Insert           'insert a blank row
        Range("C" & 2) = Range("C" & 2 + 1) - 1   'and new date in column C
    Loop
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    MsgBox "Done!"
End Sub