Expanding between two dates (start and end) along with other information

[alexaferrer]

Hi,

I'm wondering how I can turn this

Customer ID Start Date End Date Type Event 1122334455 15-May-18 30-May-18 A Wedding 1122334456 16-Jun-18 17-Jun-18 A Birthday 1122334457 1-Dec-18 5-Dec-18 B Birthday 1122334458 3-Dec-18 5-Dec-18 B Wedding

to this

Date	Customer ID	Type	Event
15-May-18	1122334455	A	Wedding
16-May-18	1122334455	A	Wedding
17-May-18	1122334455	A	Wedding
18-May-18	1122334455	A	Wedding
19-May-18	1122334455	A	Wedding
20-May-18	1122334455	A	Wedding
21-May-18	1122334455	A	Wedding
22-May-18	1122334455	A	Wedding
23-May-18	1122334455	A	Wedding
24-May-18	1122334455	A	Wedding
25-May-18	1122334455	A	Wedding
26-May-18	1122334455	A	Wedding
27-May-18	1122334455	A	Wedding
28-May-18	1122334455	A	Wedding
29-May-18	1122334455	A	Wedding
30-May-18	1122334455	A	Wedding
16-Jun-18	1122334456	A	Birthday
17-Jun-18	1122334456	A	Birthday
1-Dec-18	1122334457	B	Birthday
2-Dec-18	1122334457	B	Birthday
3-Dec-18	1122334457	B	Birthday
4-Dec-18	1122334457	B	Birthday
5-Dec-18	1122334457	B	Birthday
3-Dec-18	1122334458	B	Wedding
4-Dec-18	1122334458	B	Wedding
5-Dec-18	1122334458	B	Wedding

I have to do this for more date ranges so I'm hoping to find a better way of doing it. I'm a VBA newbie as well.

Thanks for the help!

[mancubus]

welcome to the forum.

try this

Sub vbaxp_63305_expanding_between_two_dates()

    Dim baseList, subList
    Dim i As Long, j As Long
    
    baseList = Worksheets("Sheet1").Cells(1).CurrentRegion.Value
    
    With Worksheets("Sheet2")
        .Cells.Clear 'clear previous data, if any
        .Range("A1:D1").Value = Array("Date", "Customer ID", "Type", "Event") 'insert 4 col headers
    End With
    
    For i = 2 To UBound(baseList, 1)
        ReDim subList(1 To CLng(baseList(i, 3)) - CLng(baseList(i, 2)) + 1, 1 To 4)
        For j = LBound(subList, 1) To UBound(subList, 1)
            subList(j, 1) = CDate(baseList(i, 2))
            subList(j, 2) = baseList(i, 1)
            subList(j, 3) = baseList(i, 4)
            subList(j, 4) = baseList(i, 5)
            
            baseList(i, 2) = CDate(CDbl(baseList(i, 2)) + 1) 'increment +1 up to the end date
        Next j

        Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(subList, 1), 4).Value = subList
    Next i

End Sub