PDA

View Full Version : VBA separate range of dates in cells with duration



marvin
11-24-2014, 06:12 AM
The code from Søren Holten Hansen under (stackoverflow.com /questions/20428227/vba-excel-separate-range-of-date-in-cells/27102966) actually has part of my answer, but not completely.

I need to split dates along with their respective duration.

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


**I need it to look like this:**
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!!!

Note - The other forum needed me to try something out myself, but with limited knowledge i am unable to do so :(

Thank you,
Marvin.

marvin
11-24-2014, 06:14 AM
thank you for your help in advance!!!

marvin
11-24-2014, 07:20 AM
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

'Deletes last column with dates
Ws.Cells(1, nCol + 2).EntireColumn.Delete

Application.ScreenUpdating = True
End Sub