VBA separate range of dates in cells with duration

[tequilasunsette]

I need to split dates along with their respective duration.

example:
Begin Date | End Date |Duration
3-Nov 5-Nov 2.5


**I need it to look like this in excel:**
3-Nov | 1
4-Nov | 1
5-Nov | 0.5

I need the half day to be shown on the last day. I am not sure how to make this split.
Appreciate the help this forum provides. This will really save my life!!!


this code works only with splitting the dates. dont know how to apply that and split the days as well

Sub SeperateDateRange()
    Dim Ws As Worksheet
    Dim nCol As Integer

    'Define sheet
    Set Ws = ActiveSheet

    nCol = 1 '<~~ Defines the number of columns before the date columns

    Application.ScreenUpdating = False

    'Loops throuh cells
    For i = 1 To ActiveSheet.Cells(Rows.Count, nCol + 2).End(xlUp).Row - 1 Step 1
        For j = 0 To Ws.Cells(i + 1, nCol + 2).Value - Ws.Cells(i + 1, nCol + 1).Value Step 1

            With Ws.Cells(Ws.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
                For k = 0 To nCol - 1 Step 1
                    .Offset(0, k).Value = Ws.Cells(i + 1, k + 1).Value
                Next k
                .Offset(0, nCol).Value = DateSerial(Year(Ws.Cells(i + 1, nCol + 1).Value), Month(Ws.Cells(i + 1, nCol + 1).Value), Day(Ws.Cells(i + 1, nCol + 1).Value) + j)
            End With
        Next j
    Next i

    Application.ScreenUpdating = True
End Sub

thanks for your help!

regards,
Marvin.

 

[onlyadrafter]

Hello,

I assume the duration is almost equal to the number of days between the two dates.

Sub SPLIT_DATES()
    For MY_ROWS = 2 To Range("A" & Rows.Count).End(xlUp).Row
        MY_START_DATE = Range("A" & MY_ROWS).Value
        MY_END_DATE = Range("B" & MY_ROWS).Value
        MY_DURATION = Range("C" & MY_ROWS).Value
        MY_DATES = MY_END_DATE + 1 - MY_START_DATE
        MY_DURATION_SPLIT = MY_DURATION / MY_DATES
        For MY_DATE_ROWS = 0 To MY_DATES - 2
            Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = MY_START_DATE + MY_DATE_ROWS
            Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = Round(MY_DURATION_SPLIT, 0)
            MY_COUNT = MY_COUNT + Round(MY_DURATION_SPLIT, 0)
        Next MY_DATE_ROWS
            Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = MY_END_DATE
            Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = MY_DURATION - MY_COUNT
            MY_COUNT = 0
    Next MY_ROWS
End Sub

This will put the data in cols E and F. Not sure how it will work on other data.