Expanding date ranges into individual dates

[jjonziez007]

Can someone please help me???!! I have a list of individuals with date ranges in Excel 2013. I am trying to expand the date range into single dates for each individual. Example:

Column A Column B Column C
Individual Name Service Start Date Service End Date
Kevin Smith 1/1/2010 1/1/2011
John Doe 8/12/2009 8/15/2009
Sue Jones 1/1/2017 1/12/2017


I'm trying to achieve this result with a formula/code:

Column D Column E
Individual Name Date
Kevin Smith 1/1/2010
Kevin Smith 1/2/2010
Kevin Smith 1/3/2010
Kevin Smith 1/4/2010
Kevin Smith 1/5/2010 and so on.......
John Doe 8/12/2009
John Doe 8/13/2009
John Doe 8/14/2009 and so on.....
Sue Jones 1/1/2017
Sue Jones 1/2/2017 and so on......


Please help!!!!

 

[Joe4]

Welcome to the Board!

This should do that:

Sub MyExpandMacro()

    Dim myLastRow As Long
    Dim myRow As Long
    Dim startDate As Date
    Dim endDate As Date
    Dim myName As String
    Dim myDate As Date
    Dim counter As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    myLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows in column A starting with row 2
    counter = 2
    For myRow = 2 To myLastRow
'       Capture name and start and end dates
        myName = Cells(myRow, "A")
        startDate = Cells(myRow, "B")
        endDate = Cells(myRow, "C")
'       Check to see if start and end dates populated and end is after start
        If (startDate > 0) And (endDate >= startDate) Then
'           Loop through all dates
            For myDate = startDate To endDate
                Cells(counter, "D") = myName
                Cells(counter, "E") = myDate
                counter = counter + 1
            Next myDate
        End If
    Next myRow
    
    Application.ScreenUpdating = True
    
End Sub

 

[jjonziez007]

Thank you, thank you, thank you! You saved the day I have an Excel spreadsheet of 20,000 rows...do I have to keep hitting F8 to execute this code? Or is there another button I can hit?

Welcome to the Board!

This should do that:

Sub MyExpandMacro()

    Dim myLastRow As Long
    Dim myRow As Long
    Dim startDate As Date
    Dim endDate As Date
    Dim myName As String
    Dim myDate As Date
    Dim counter As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    myLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows in column A starting with row 2
    counter = 2
    For myRow = 2 To myLastRow
'       Capture name and start and end dates
        myName = Cells(myRow, "A")
        startDate = Cells(myRow, "B")
        endDate = Cells(myRow, "C")
'       Check to see if start and end dates populated and end is after start
        If (startDate > 0) And (endDate >= startDate) Then
'           Loop through all dates
            For myDate = startDate To endDate
                Cells(counter, "D") = myName
                Cells(counter, "E") = myDate
                counter = counter + 1
            Next myDate
        End If
    Next myRow
    
    Application.ScreenUpdating = True
    
End Sub

 

[Joe4]

I have an Excel spreadsheet of 20,000 rows...do I have to keep hitting F8 to execute this code? Or is there another button I can hit?

I am not sure what you mean.
It should do it for all your entries in column A, regardless of how many rows that is. You just just have to run the macro once, and it should do it for all records in column A.

 

[jjonziez007]

Got it, sorry! Excel froze on me but then I re-ran it and everything populated.
Have a wonderful day and thank you for literally saving me HOURS of headaches

 

[Joe4]

Excel froze on me but then I re-ran it and everything populated.

Not surprising, based on the size of your data. You may want to make sure that Excel has most of your computer's resources when running (i.e. close other programs open on your computer).
Hopefully, you don't run into running out of rows on your worksheet!