Results 1 to 6 of 6

Thread: adding missing dates
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Jun 2014
    Posts
    48
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default adding missing dates

    I have a table with several columns. The first is a name and the second is a date. For each name there are several dates. The dates should be sequential. If there is a gap of one or more days, I would like to add a line with the name and the missing date.
    david 3/5/19
    david 3/6/19
    david 3/8/19
    david 3/9/19
    John 3/11/19
    John 3/15/19
    John 3/16/19

  2. #2
    Rules violation
    Join Date
    Jan 2012
    Posts
    912
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: adding missing dates

    You could do it with Power Query, but here is a VBA solution

    Code:
    Sub AddDates()
    Dim firstdate As Date, lastdate As Date
    Dim numrows As Long, numdates As Long, numinsert As Long
    Dim lastrow As Long
    Dim i As Long
        Application.ScreenUpdating = False
        With ActiveSheet
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            For i = lastrow To 2 Step -1
            
                lastdate = .Cells(i, "B").Value
                numrows = Application.CountIf(.Columns(1), .Cells(i, "A").Value)
                firstdate = .Cells(i - numrows + 1, "B").Value
                numdates = lastdate - firstdate + 1
                numinsert = numdates - numrows
                If numinsert > 0 Then .Rows(i + 1).Resize(numinsert).Insert
                .Cells(i - numrows + 1, "A").Resize(numdates).Value = .Cells(i, "A").Value
                .Cells(i - numrows + 1, "B").Resize(numdates).DataSeries Rowcol:=xlColumns, _
                                                                         Type:=xlChronological, _
                                                                         Date:=xlDay, _
                                                                         Step:=1, Stop:=lastdate, _
                                                                         Trend:=False
                i = i - numrows + 1
            Next i
        End With
        Application.ScreenUpdating = True
    End Sub

  3. #3
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,893
    Post Thanks / Like
    Mentioned
    72 Post(s)
    Tagged
    7 Thread(s)

    Default Re: adding missing dates

    Try this
    - code inserts a new sheet which is a copy of the original sheet and the macro works on that data
    - which makes it easier to rerun whilst testing
    - source data remains undamaged!
    - amend sheet name in the code to match the name of the sheet containing your data


    Source data Starts in A2
    Excel 2016 (Windows) 32 bit
    A
    B
    1
    Name Date
    2
    david
    03/05/2019
    3
    david
    03/06/2019
    4
    david
    03/08/2019
    5
    david
    03/09/2019
    6
    John
    03/11/2019
    7
    John
    03/15/2019
    8
    John
    03/16/2019
    Sheet: Sheet1

    New sheet created which looks like this
    Excel 2016 (Windows) 32 bit
    A
    B
    1
    Name Date
    2
    david
    03/05/2019
    3
    david
    03/06/2019
    4
    david
    03/07/2019
    5
    david
    03/08/2019
    6
    david
    03/09/2019
    7
    John
    03/11/2019
    8
    John
    03/12/2019
    9
    John
    03/13/2019
    10
    John
    03/14/2019
    11
    John
    03/15/2019
    12
    John
    03/16/2019
    Sheet: Sheet1 (2)

    Code:
    Sub InsertDates()
        Dim ws As Worksheet, r As Long, lastRow As Long, diff As Integer
        Dim A1 As Range, A2 As Range, B1 As Range, B2 As Range
        
        Sheets("Sheet1").Copy After:=Worksheets(Sheets.Count)
        Set ws = Worksheets(Sheets.Count)
        lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
        
        For r = lastRow - 1 To 2 Step -1
            Set A1 = ws.Cells(r, "A")
            Set A2 = A1.Offset(1)
            Set B1 = A1.Offset(, 1)
            Set B2 = B1.Offset(1)
            diff = B2 - B1
            
            If A1 = A2 And diff > 1 Then
                A2.Resize(diff - 1).EntireRow.Insert
                A1.Resize(diff) = A1
                B1.AutoFill Destination:=B1.Resize(diff), Type:=xlFillDefault
            End If
        Next r
    End Sub

    I have a table
    - is this a structured table created with Insert Table (the code also works)

    Excel 2016 (Windows) 32 bit
    A
    B
    1
    Name Date
    2
    david
    03/05/2019
    3
    david
    03/06/2019
    4
    david
    03/08/2019
    5
    david
    03/09/2019
    6
    John
    03/11/2019
    7
    John
    03/15/2019
    8
    John
    03/16/2019
    Sheet: Sheet1

    Excel 2016 (Windows) 32 bit
    A
    B
    1
    Name Date
    2
    david
    03/05/2019
    3
    david
    03/06/2019
    4
    david
    03/07/2019
    5
    david
    03/08/2019
    6
    david
    03/09/2019
    7
    John
    03/11/2019
    8
    John
    03/12/2019
    9
    John
    03/13/2019
    10
    John
    03/14/2019
    11
    John
    03/15/2019
    12
    John
    03/16/2019
    Sheet: Sheet1 (4)

  4. #4
    New Member
    Join Date
    Jun 2014
    Posts
    48
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Post Re: adding missing dates

    Thanks for the quick response. It is working. Thanks again
    Quote Originally Posted by theBardd View Post
    You could do it with Power Query, but here is a VBA solution

    Code:
    Sub AddDates()
    Dim firstdate As Date, lastdate As Date
    Dim numrows As Long, numdates As Long, numinsert As Long
    Dim lastrow As Long
    Dim i As Long
        Application.ScreenUpdating = False
        With ActiveSheet
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            For i = lastrow To 2 Step -1
            
                lastdate = .Cells(i, "B").Value
                numrows = Application.CountIf(.Columns(1), .Cells(i, "A").Value)
                firstdate = .Cells(i - numrows + 1, "B").Value
                numdates = lastdate - firstdate + 1
                numinsert = numdates - numrows
                If numinsert > 0 Then .Rows(i + 1).Resize(numinsert).Insert
                .Cells(i - numrows + 1, "A").Resize(numdates).Value = .Cells(i, "A").Value
                .Cells(i - numrows + 1, "B").Resize(numdates).DataSeries Rowcol:=xlColumns, _
                                                                         Type:=xlChronological, _
                                                                         Date:=xlDay, _
                                                                         Step:=1, Stop:=lastdate, _
                                                                         Trend:=False
                i = i - numrows + 1
            Next i
        End With
        Application.ScreenUpdating = True
    End Sub

  5. #5
    New Member
    Join Date
    Jun 2014
    Posts
    48
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: adding missing dates

    Thanks for the quick response. I tested it and it is working. Thanks again, you saved me a lot of time!!!!

  6. #6
    New Member
    Join Date
    Jun 2014
    Posts
    48
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: adding missing dates

    Thanks Yongle, It is working. It was a good idea to write the results in a new sheet

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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