Splitting Data into Months based on Date Range

markm94

New Member
Joined
Sep 2, 2019
Messages
3
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.

IDStatusFirstLastMarketStartEndDaysValue/DayTotal Value
ABCConfirmedABCXYZUK15/10/1920/10/195500025000
BCDConfirmedABCXYZUS28/10/1903/11/19610006000
CDEConfirmedABCXYZUK05/11/1907/11/1925001000

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

IDStatusFirstLastMarketStartEndDaysValue/DayTotal Value
ABCConfirmedABCXYZUK15/10/1920/10/195500025000
BCDConfirmedABCXYZUS28/10/1901/11/19410004000
BCDConfirmedABCXYZUS01/11/1903/11/19210002000
CDEConfirmedABCXYZUK05/11/1907/11/192500
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!! :)
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Eric W

MrExcel MVP
Joined
Aug 18, 2015
Messages
9,742
Welcome to the Board!

Try this on a copy of your workbook:

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

New Member
Joined
Sep 2, 2019
Messages
3
Hi Eric, you are amazing! This works perfectly! Thank you very much for your help :)
 

Watch MrExcel Video

Forum statistics

Threads
1,098,855
Messages
5,465,094
Members
406,412
Latest member
superjoejoe

This Week's Hot Topics

Top