Add Missing Dates

[Admin]

Hi

there might be a better solution. In the meantime try this.

Sub kTest()
    
    Dim d   As Date, ed As Date
    Dim r   As Range, c As Range
    Dim i   As Long
    
    Set r = Range("d" & Rows.Count).End(xlUp)
    d = CDate(r.Value2)
    ed = DateSerial(Year(d), Month(d) + 1, 1) - 1
    
    For i = r.Row To 1 Step -1
        Set c = Cells(i, r.Column)
        d = CDate(c.Value2)
        If ed - d > 1 Then
            c.Offset(1).Resize(Day(ed) - Day(d) - 1).EntireRow.Insert
            c.AutoFill c.Resize(Day(ed) - Day(d) + 1)
        End If
        ed = CDate(d)
    Next
    If Day(ed) > 1 Then
        c.Resize(Day(ed) - 1).EntireRow.Insert
        Cells(1, r.Column) = DateSerial(Year(ed), Month(ed), 1)
        Cells(1, r.Column).AutoFill Cells(1, r.Column).Resize(Day(ed))
    End If

End Sub

[PcMax]

Hi

Excellent solution, with this cycle.

[PcMax]

Hi,

A modification to the code to operate from a different range

Sub kTest21()
    
    Dim d   As Date, ed As Date
    Dim r   As Range, c As Range
    Dim i   As Long
    Dim list   As Long:    list = 21
    Set r = Range("d" & Rows.Count).End(xlUp)

    d = CDate(r.Value2)

    ed = DateSerial(Year(d), Month(d) + 1, 1) - 1
    
    For i = r.Row To 1 Step -1
        Set c = Cells(i, r.Column)
        
        If Val(c.Value2) = 0 Then Exit For
        
        d = CDate(c.Value2)
        If ed - d > 1 Then
            c.Offset(1).Resize(Day(ed) - Day(d) - 1).EntireRow.Insert
            c.AutoFill c.Resize(Day(ed) - Day(d) + 1)
        End If
        ed = CDate(d)
    Next
    If Day(ed) > 1 Then
        c.Offset(1).Resize(Day(ed - 1)).EntireRow.Insert
        Cells(list, r.Column) = DateSerial(Year(ed), Month(ed), 1)
        Cells(list, r.Column).AutoFill Cells(list, r.Column).Resize(Day(ed))
    End If

End Sub

changes suggestion