VBA code help - Add a line for each missing date with the start and end date defined in a cell

0 votes

I now have the code below, which inserts a line for each date that is absent but not for dates that are missing at the end or beginning of the month. Could someone please rewrite the code to add all missing dates between a start date and an end date? Cells A2 and B2 on the "Summary" worksheet's start and finish dates should be easily editable since they would need to be updated on a monthly basis. It's also important to note that data from the cell below is copied for each line that is added.

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).Insert xlShiftDown

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

Below is an example of the data before updating

Data Before updating

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

Data after running macro

Any help would be greatly appreciated.

Jan 24, 2023 in Others by Kithuzzz
• 38,010 points

1 answer to this question.

0 votes

Try this:

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).Insert xlShiftDown
            .Cells(2, "D") = DateSerial(Year(dt1), Month(dt1), 1)
            n = n + 1
        End If

        i = .Cells(.Rows.Count, "D").End(xlUp).Row
            .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).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
answered Jan 24, 2023 by narikkadan
• 63,420 points

Related Questions In Others

0 votes
1 answer
0 votes
1 answer

Create a hyperlink to a sheet with same name as the value in the selected cell in Excel through VBA

Credit to Spectral Instance who found the ...READ MORE

answered Feb 6, 2023 in Others by narikkadan
• 63,420 points
0 votes
1 answer

What VBA code would I use to concatenate cell A2 & B2 in cell C2 and then have it Autofill down the column?

Solution Find the last row. Write a formula to ...READ MORE

answered Feb 14, 2023 in Others by Kithuzzz
• 38,010 points
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 23,260 points
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,670 points
0 votes
1 answer
0 votes
1 answer

VBA Export as PDF and Save to Location with name as per a Cell in the worksheet

Following is the code that gets generated ...READ MORE

answered Jan 20, 2023 in Others by narikkadan
• 63,420 points
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP