Splitting Data into Months based on Date Range

[markm94]

I have been doing some research but was unable to find exactly what I am trying to achieve. I have been working with VBA frequently but am not quite advanced enough yet to do do this, so I would really appreciate some help!

I have a list of customer bookings, with various information and a date range. I need the customer bookings that overlap several months to be split into separate rows. Customer bookings that are entirely within a single month do not need to be split. The tricky part is that I need to have some of the fields calculated based on the date rage. For example, I need the number of days for each booking to be split into the corresponding months and the booking value to be split too.

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Status[/TD]
[TD]First[/TD]
[TD]Last[/TD]
[TD]Market[/TD]
[TD]Start[/TD]
[TD]End[/TD]
[TD]Days[/TD]
[TD]Value/Day[/TD]
[TD]Total Value[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]Confirmed[/TD]
[TD]ABC[/TD]
[TD]XYZ[/TD]
[TD]UK[/TD]
[TD]15/10/19[/TD]
[TD]20/10/19[/TD]
[TD]5[/TD]
[TD]5000[/TD]
[TD]25000[/TD]
[/TR]
[TR]
[TD]BCD[/TD]
[TD]Confirmed[/TD]
[TD]ABC[/TD]
[TD]XYZ[/TD]
[TD]US[/TD]
[TD]28/10/19[/TD]
[TD]03/11/19[/TD]
[TD]6[/TD]
[TD]1000[/TD]
[TD]6000[/TD]
[/TR]
[TR]
[TD]CDE[/TD]
[TD]Confirmed[/TD]
[TD]ABC[/TD]
[TD]XYZ[/TD]
[TD]UK[/TD]
[TD]05/11/19[/TD]
[TD]07/11/19[/TD]
[TD]2[/TD]
[TD]500[/TD]
[TD]1000[/TD]
[/TR]
</tbody>[/TABLE]

The above should convert into the below, splitting the second booking into 2 rows and calculating the Days and Total Value (days multiplied by Value/Day):

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Status[/TD]
[TD]First[/TD]
[TD]Last[/TD]
[TD]Market[/TD]
[TD]Start[/TD]
[TD]End[/TD]
[TD]Days[/TD]
[TD]Value/Day[/TD]
[TD]Total Value[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]Confirmed[/TD]
[TD]ABC[/TD]
[TD]XYZ[/TD]
[TD]UK[/TD]
[TD]15/10/19[/TD]
[TD]20/10/19[/TD]
[TD]5[/TD]
[TD]5000[/TD]
[TD]25000[/TD]
[/TR]
[TR]
[TD]BCD[/TD]
[TD]Confirmed[/TD]
[TD]ABC[/TD]
[TD]XYZ[/TD]
[TD]US[/TD]
[TD]28/10/19[/TD]
[TD]01/11/19[/TD]
[TD]4[/TD]
[TD]1000[/TD]
[TD]4000[/TD]
[/TR]
[TR]
[TD]BCD[/TD]
[TD]Confirmed[/TD]
[TD]ABC[/TD]
[TD]XYZ[/TD]
[TD]US[/TD]
[TD]01/11/19[/TD]
[TD]03/11/19[/TD]
[TD]2[/TD]
[TD]1000[/TD]
[TD]2000[/TD]
[/TR]
[TR]
[TD]CDE[/TD]
[TD]Confirmed[/TD]
[TD]ABC[/TD]
[TD]XYZ[/TD]
[TD]UK[/TD]
[TD]05/11/19[/TD]
[TD]07/11/19[/TD]
[TD]2[/TD]
[TD]500
[/TD]
[TD]1000[/TD]
[/TR]
</tbody>[/TABLE]

If there are bookings that are more long term, they would have to be split into several rows (for instance a booking from October to December will have to be split into 3).

Thank you for your help in advance!!

 

[Eric W]

Welcome to the Board!

Try this on a copy of your workbook:

Sub SplitBookings()
Dim r As Long

    Application.ScreenUpdating = False
    r = 2
    While Cells(r, "A") <> ""
        If Cells(r, "G") > WorksheetFunction.EoMonth(Cells(r, "F"), 0) + 1 Then
            Rows(r + 1).Insert
            Rows(r).Copy Rows(r + 1)
            Cells(r, "G") = WorksheetFunction.EoMonth(Cells(r, "F"), 0) + 1
            Cells(r + 1, "F") = Cells(r, "G")
            Cells(r, "H") = Cells(r, "G") - Cells(r, "F")
            Cells(r, "J") = Cells(r, "H") * Cells(r, "I")
            Cells(r + 1, "H") = Cells(r + 1, "G") - Cells(r + 1, "F")
            Cells(r + 1, "J") = Cells(r + 1, "H") * Cells(r + 1, "I")
        End If
        r = r + 1
    Wend
    Application.ScreenUpdating = True
            
End Sub

 

[markm94]

Hi Eric, you are amazing! This works perfectly! Thank you very much for your help

 

[Eric W]

Glad it works for you!