Add Missing Dates

[PcMax]

Hi,

With the following code to insert the missing dates from an ordered list

2-Apr-14
3-Apr-14
5-Apr-14
6-Apr-14
6-Apr-14
6-Apr-14
7-Apr-14
9-Apr-14
11-Apr-14
11-Apr-14
12-Apr-14
12-Apr-14
12-Apr-14

Sub AddMissingDates()
  Dim i As Long:  i = 1

  Do
    If Cells(i + 1, "D") > Cells(i, "D") + 1 Then
        Rows(i + 1).Insert xlShiftDown
        Cells(i + 1, "D") = Cells(i, "D") + 1
    End If
    i = i + 1
  Loop Until Cells(i + 1, "D") = ""

End Sub

How could I change to display a period from the day= 1 to day = 30

thank you in advance

[snb]

Sub M_snb()
    with Cells(1, 4)
      .value = DateSerial(Year(.value), Month(.Value), 1)
      .AutoFill .Resize(31)
    end with
End Sub

[PcMax]

Hi,

Great suggestion.

I need to be able to view multiple times on the same date
The list that I get is the following for research in that period

01-apr-14
02-apr-14
03-apr-14
04-apr-14
05-apr-14
06-apr-14
06-apr-14
06-apr-14
07-apr-14
08-apr-14
09-apr-14
10-apr-14
11-apr-14
11-apr-14
12-apr-14
12-apr-14
12-apr-14
12-apr-14
12-apr-14
12-apr-14
13-apr-14
14-apr-14
15-apr-14
16-apr-14
17-apr-14
18-apr-14
19-apr-14
20-apr-14
21-apr-14
22-apr-14
23-apr-14
24-apr-14
25-apr-14
26-apr-14
27-apr-14
28-apr-14
29-apr-14
30-apr-14

[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

[Admin]

Hi

Set r = Cells(Rows.Count, List).End(xlUp)

I assume the variable List is the column number.

[PcMax]

Hi,

Maybe I hid the code:

Dim list   As Long:    list = 21

I used the variable list to indicate the beginning of the table
To insert the missing days with the code

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

The code works correctly
Thank you so much

[snb]

Sub M_snb()
    c00 = Join([transpose(text(date(year(A1),month(A1),0)+row(1:31),"yyyy-mm-dd"))], ",")
    sq = Filter([transpose(if(A1:A200="","~",if(countif(A1:A200,A1:A200)>1,text(A1:A200,"yyyy-mm-dd"),"~")))], "~", False)
    
    Do Until UBound(sq) = -1
       c00 = Replace(c00, sq(0), Join(Filter(sq, sq(0)), ","))
       sq = Filter(sq, sq(0), False)
    Loop

    sq = Split(Replace(c00, "_", ","), ",")
    Cells(1, 6).Resize(UBound(sq) + 1) = Application.Transpose(sq)
End Sub