Add missing dates to column

[davidmg1982]

I have the following code, that inserts the missing date within column 'ReportDate' until finds todays date:

Dim i As Long
Dim RowCount As Long

i = 4

Do
    If Cells(i, 1) + 1 < Cells(i + 1, 1) Then
        Rows(i + 1).Insert
        Cells(i + 1, 1) = Cells(i, 1) + 1
    End If
    If (Cells(i + 1, 1) = "") Then
        Cells(i + 1, 1) = Cells(i, 1) + 1
    End If
    i = i + 1
Loop Until Cells(i, 1).Value >= Date

Problem is it stops when the first todays date if found, and I need it to continue with the rest of the list.
To put it on an example in the table below, its only doing it for "AR" values in CountryCode, and I need it to do the same for the rest of the list: "BR", "CL", etc.. until finds the last value.
Thanks ahead for your guidance.

CountryCode	ReportDate	Value
AR	7/22/2021​	10​
AR	7/23/2021​	10​
AR	7/25/2021​	30​
AR	7/26/2021​	10​
AR	7/27/2021​	30​
AR	7/28/2021​	28​
AR	7/29/2021​	30​
BR	7/22/2021​	59​
BR	7/23/2021​	65​
BR	7/24/2021​	87​
BR	7/25/2021​	96​
BR	7/26/2021​	54​
BR	7/27/2021​	321​
BR	7/28/2021​	5​
BR	7/29/2021​	15​
BR	7/30/2021​	658​
BR	7/31/2021​	85​
CL	7/22/2021​	59​
CL	7/23/2021​	62​
CL	7/24/2021​	32​
CL	7/26/2021​	258​
CL	7/27/2021​	25​
CL	7/28/2021​	58​
CL	7/29/2021​	8​
CL	7/30/2021​	47​

 

[Joe4]

I don't think your sample data matches your code.
Your code is looking at dates in the first column, but in your example, your dates are in the second column.

Also, your code only does the insert on days in the past, but all the dates in your sample data are future dates.

Can you clarify your requirements and your sample data to resolve these discrepancies?

 

[davidmg1982]

Yes, you are correct, I had a previous step that moves column ReportDate to column 1, the dates are variable but they always have the same start, every day I download a year range in this case from 07/21/2020 to 07/22/2021 and I always have missing days in the report that I need to Insert the new date and copy all the values from the day before (row above from Col A to Col CC), so I have this range of days repeating for each country in column B, using the example below my code only does it for the first country and I need to continue with the rest. Thanks for your help.

Here the complete code:

Sub Copyfiles()
Application.DisplayAlerts = False
Path = "C:\Users\davidmunoz2\Documents\KPMG Confidential\Continuous Monitoring\Source Files\"
Filename = Dir(Path & "*.csv")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
     
'''FIND COLUMN WITH REPORT DATE'''
With ActiveSheet.UsedRange
    Set c = .Find("ReportDate", LookIn:=xlValues)
    Set d = .Find("ReportInsert", LookIn:=xlValues)
If Not c Is Nothing Then
    Columns(c.Column).Cut
    Columns("A").Insert
Else
If Not d Is Nothing Then
    Columns(d.Column).Cut
    Columns("A").Insert
End If
    End If
End With
'''END FIND COLUMN WITH REPORT DATE'''

''''INSERT NEW DATE'''
Dim i As Long
Dim RowCount As Long

i = 4

Do
    If Cells(i, 1) + 1 < Cells(i + 1, 1) Then
        Rows(i + 1).Insert
        Cells(i + 1, 1) = Cells(i, 1) + 1
    End If
    If (Cells(i + 1, 1) = "") Then
        Cells(i + 1, 1) = Cells(i, 1) + 1
    End If
    i = i + 1
Loop Until Cells(i, 1).Value >= Date
'''END INSERT NEW DATE'''

'''COPY INFO ABOVE'''
    Dim cell As Range, SearchRange As Range

    On Error Resume Next
    Set SearchRange = Columns("B:CC").SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    If Not SearchRange Is Nothing Then
        For Each cell In SearchRange

            If cell.Row > 1 Then cell = cell.Offset(-1, 0).Value

        Next cell
    End If
'''END COPY INFO ABOVE'''

  Loop
  
  Call GetXlsx
  
End Sub

 

[Joe4]

Try changing your loop to this, and see if it works:

Do
    If ((Cells(i, 1) + 1) < Cells(i + 1, 1)) And (Cells(i, 1).Value < Date) Then
        Rows(i + 1).Insert
        Cells(i + 1, 1) = Cells(i, 1) + 1
    End If
    i = i + 1
Loop Until Cells(i, 1).Value = ""

 

[davidmg1982]

Works perfect, thank you very much.

 

[Joe4]

You are welcome.
Glad I was able to help!