PDA

View Full Version : Expanding between two dates (start and end) along with other information



alexaferrer
07-30-2018, 10:16 PM
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
07-31-2018, 01:48 AM
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