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.

ID	Status	First	Last	Market	Start	End	Days	Value/Day	Total Value
ABC	Confirmed	ABC	XYZ	UK	15/10/19	20/10/19	5	5000	25000
BCD	Confirmed	ABC	XYZ	US	28/10/19	03/11/19	6	1000	6000
CDE	Confirmed	ABC	XYZ	UK	05/11/19	07/11/19	2	500	1000

<tbody>
</tbody>

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):

ID	Status	First	Last	Market	Start	End	Days	Value/Day	Total Value
ABC	Confirmed	ABC	XYZ	UK	15/10/19	20/10/19	5	5000	25000
BCD	Confirmed	ABC	XYZ	US	28/10/19	01/11/19	4	1000	4000
BCD	Confirmed	ABC	XYZ	US	01/11/19	03/11/19	2	1000	2000
CDE	Confirmed	ABC	XYZ	UK	05/11/19	07/11/19	2	500	1000

<tbody>
</tbody>

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!