I'm new to writing VBA code and need some help.

So far I have the below code which adds a line for each missing date but it doesn't add any lines for dates that are missing at the end or start of the month. Could someone help with rewriting the code so it adds all dates that are missing between a start and end date. The start and end date would need updated monthly so needs to be easily changed e.g. cells A2 and B2 on the "Summary" worksheet. Also worth noting for each line added it copies the data from the cell below.

Dim wks As Worksheet
Set wks = Worksheets("NAV_REPORT_FSIGLOB1")

Dim lastRow As Long
lastRow = Range("D2").End(xlDown).Row

For i = lastRow To 2 Step -1
    curcell = wks.Cells(i, 4).Value
    prevcell = wks.Cells(i - 1, 4).Value

    Do Until curcell - 1 <= prevcell
        wks.Rows(i).Copy
        wks.Rows(i).Insert xlShiftDown

        curcell = wks.Cells(i   1, 4) - 1
        wks.Cells(i, 4).Value = curcell
    Loop
Next i 

Below is an example of the data before updating

Below is how I would like the data after running macro.

Any help would be greatly appreciated.

CodePudding user response：

Sub FillDates()

    Dim wks As Worksheet, i As Long, n As Long
    Dim dt1 As Date, dt2 As Date, x As Long, d As Long
    
    Set wks = Worksheets("NAV_REPORT_FSIGLOB1")
    With wks
        'make start 1st
        dt1 = .Cells(2, "D")
        If Day(dt1) > 1 Then
            .Rows(2).Copy
            .Rows(2).Insert xlShiftDown
            .Cells(2, "D") = DateSerial(Year(dt1), Month(dt1), 1)
            n = n   1
        End If

        i = .Cells(.Rows.Count, "D").End(xlUp).Row
        Do
            .Cells(i, "D").Select
            dt1 = .Cells(i - 1, "D")
            dt2 = .Cells(i, "D")
            
            d = DateDiff("d", dt1, dt2)
            If d = 1 Then
                i = i - 1
            ElseIf d > 1 Then
                .Rows(i).Copy
                .Rows(i).Insert xlShiftDown
                .Cells(i, "D") = DateAdd("d", -1, dt2)
                n = n   1
            ElseIf d < 1 Then
                MsgBox "Date sequence error", vbCritical
                Exit Sub
            End If
            
            ' escape infinite loop
            x = x   1
            If x > 100 Then
                 MsgBox "Too many iterations > 100", vbCritical
                 Exit Sub
            End If
        Loop While i > 2
    
    End With
    MsgBox n & " rows added"

End Sub

CodePudding user response：

Using as much of your existing code as possible, you can use the following. Tested with a Summary sheet with Start date in A1, End date in A2.

Sub test_this()
 
    Dim wks As Worksheet, ssh As Worksheet
    Set wks = Worksheets("NAV_REPORT_FSIGLOB1")
    Set ssh = Worksheets("SUMMARY")
    Dim lastRow As Long, start_date As Date, end_date As Date, curcell As Date
    
    lastRow = Range("D2").End(xlDown).Row
    start_date = ssh.Range("A1") - 1
    end_date = ssh.Range("A2")
    
    With wks.Cells(lastRow, 4)
        If .Value < end_date Then
            .EntireRow.Copy
            .EntireRow.Insert xlShiftDown
            lastRow = lastRow   1
            .Value = end_date
        End If
    End With

    For i = lastRow To 2 Step -1
        curcell = wks.Cells(i, 4).Value
        If i = lastRow Then curcell = end_date
        prevcell = wks.Cells(i - 1, 4).Value
        If i = 2 Then prevcell = start_date
        Do Until curcell - 1 <= prevcell
            wks.Rows(i).Copy
            wks.Rows(i).Insert xlShiftDown
            curcell = wks.Cells(i   1, 4) - 1
            wks.Cells(i, 4).Value = curcell
        Loop
    Next i

End Sub