Results 1 to 9 of 9

Thread: Add Missing Dates

  1. #1
    Senior Member
    Join Date
    Oct 2011
    Posts
    135
    Rep Power
    14

    Add Missing Dates

    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

    Code:
    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

  2. #2
    Senior Member
    Join Date
    Jun 2012
    Posts
    337
    Rep Power
    13
    Code:
    Sub M_snb()
        with Cells(1, 4)
          .value = DateSerial(Year(.value), Month(.Value), 1)
          .AutoFill .Resize(31)
        end with
    End Sub

  3. #3
    Senior Member
    Join Date
    Oct 2011
    Posts
    135
    Rep Power
    14
    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

  4. #4
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

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

    Code:
    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
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  5. #5
    Senior Member
    Join Date
    Oct 2011
    Posts
    135
    Rep Power
    14
    Hi

    Excellent solution, with this cycle.

  6. #6
    Senior Member
    Join Date
    Oct 2011
    Posts
    135
    Rep Power
    14
    Hi,

    A modification to the code to operate from a different range

    Code:
    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

  7. #7
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    Code:
    Set r = Cells(Rows.Count, List).End(xlUp)
    I assume the variable List is the column number.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  8. #8
    Senior Member
    Join Date
    Oct 2011
    Posts
    135
    Rep Power
    14
    Hi,

    Maybe I hid the code:
    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
    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

  9. #9
    Senior Member
    Join Date
    Jun 2012
    Posts
    337
    Rep Power
    13
    Code:
    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

Similar Threads

  1. Missing Numbers Range VBA
    By Rhett in forum Excel Help
    Replies: 2
    Last Post: 10-27-2013, 10:43 PM
  2. Insert Missing Dates By Comparing Two Lists Of Dates
    By mahmoud-lee in forum Excel Help
    Replies: 24
    Last Post: 10-16-2013, 04:48 PM
  3. Replies: 4
    Last Post: 04-05-2013, 12:08 PM
  4. How to Extracting dates and days between 2 dates.
    By Rajesh Kr Joshi in forum Excel Help
    Replies: 9
    Last Post: 08-11-2012, 09:11 PM
  5. Missing MSComctllib
    By Rasm in forum Excel Help
    Replies: 3
    Last Post: 04-05-2011, 09:45 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •