Breaking down some dates using a formula

Z

zelarra

Board Regular
Joined
Jan 2, 2021
Messages
70
Office Version
  1. 365
Platform
  1. Windows
Hi, guys.

I need to extract the intermediate dates by rows from a list of dates. Here are two examples:

EXAMPLE 1

14-5-21 Start
18-6-21 End
23-5-22 Start
3-2-23 End

14-5-21 Start
18-6-21 End
23-5-22 Start
31-12-22 Intermediate step 1
1-1-23 Intermediate step 2
3-2-23 End

In this example, I have a list of dates for two couples. I need to break down by year when the year of the start date does not match the year of the end date, as I indicate in the second list, which means that I go from a list of 4 rows to one of six.

EXAMPLE 2

14-5-20 Start
18-6-20 End
23-5-21 Start
3-2-24 End

14-5-20 Start
18-6-20 End
23-5-21 Start
31-12-21 Intermediate step 1
1-1-22 Start Intermediate step 2
31-12-22 Intermediate step 3
1-1-23 Intermediate step 4
31-12-23 Intermediate step 5
1-1-24 Intermediate step 6
3-2-24 End

In this example, similar to the previous one, I have put more than a year of difference between the start date and the end date, so that I should get 6 intermediate steps.

It is important that the date and a column with the texts start, intermediate step and end appear.

Thank you very much.

Dropbox

www.dropbox.com www.dropbox.com
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
Are you open to a VBA solution?
 
Upvote 1
Here's a dirty script. This assumes your data starts in A1. The result will output to columns B & C. Try...
VBA Code: 
Sub InsertDates3()
    Dim ws As Worksheet
    Dim startCell As Range
    Dim endCell As Range
    Dim currentDate As Date
    Dim lastRow As Long
    Dim stepLabel As String
   
    Set ws = ThisWorkbook.Sheets("Sheet1") 'change sheet name as needed

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For i = 1 To lastRow Step 2
        Set startCell = ws.Cells(i, 1)
        Set endCell = ws.Cells(i + 1, 1)
       
        ' Insert the start date and label
        ws.Cells(i, 2).Value = startCell.Value
        ws.Cells(i, 3).Value = "Start"
       
        ' Insert dates between start and end dates
        currentDate = startCell.Value
        stepLabel = "Intermediate Step 1"
        Do While currentDate < endCell.Value
            ' Insert end of year for the current year if end year is different
            If Year(currentDate) <> Year(endCell.Value) Then
                ws.Cells(ws.Rows.Count, 2).End(xlUp).Offset(1, 0).Value = DateSerial(Year(currentDate), 12, 31)
                ws.Cells(ws.Rows.Count, 3).End(xlUp).Offset(1, 0).Value = stepLabel
                stepLabel = "Intermediate Step " & (Val(Mid(stepLabel, Len("Intermediate Step ") + 1)) + 1)
            End If
            ' Insert beginning of next year
            currentDate = DateSerial(Year(currentDate) + 1, 1, 1)
            ' If the beginning of next year is before the end date, insert it
            If currentDate <= endCell.Value Then
                ws.Cells(ws.Rows.Count, 2).End(xlUp).Offset(1, 0).Value = currentDate
                ws.Cells(ws.Rows.Count, 3).End(xlUp).Offset(1, 0).Value = stepLabel
                stepLabel = "Intermediate Step " & (Val(Mid(stepLabel, Len("Intermediate Step ") + 1)) + 1)
            End If
        Loop
       
        ' Insert the end date and label if it's not already inserted
        If ws.Cells(ws.Rows.Count, 2).End(xlUp).Value <> endCell.Value Then
            ws.Cells(ws.Rows.Count, 2).End(xlUp).Offset(1, 0).Value = endCell.Value
            ws.Cells(ws.Rows.Count, 3).End(xlUp).Offset(1, 0).Value = "End"
        End If
    Next i
End Sub
Book1
ABC
15/14/215/14/21Start
26/18/216/18/21End
35/23/225/23/22Start
42/3/2512/31/22Intermediate Step 1
51/1/23Intermediate Step 2
612/31/23Intermediate Step 3
71/1/24Intermediate Step 4
812/31/24Intermediate Step 5
91/1/25Intermediate Step 6
102/3/25End
Sheet1
 
Upvote 1
Hi, that's great. Thanks a lot.

Now I'm trying to readjust the code to this situation:

1717519128662.png


you can see the solution in blank cells.

I try this:

VBA Code: 
Sub InsertDates4()
    Dim ws As Worksheet
    Dim startCell As Range
    Dim endCell As Range
    Dim currentDate As Date
    Dim lastRow As Long
    Dim stepLabel As String
    Dim i As Integer
   
    Set ws = ThisWorkbook.Sheets("Hoja1") 'change sheet name as needed

    ws.Range("C:D").ClearContents

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For i = 1 To lastRow 'Step 2
    
        Set startCell = ws.Cells(i, 1)
        
        Set endCell = ws.Cells(i, 2)
              
        ' Insert dates between start and end dates
        
        currentDate = startCell.Value
                
        Do While currentDate < endCell.Value
        
            ' Insert end of year for the current year if end year is different
            
            If Year(currentDate) <> Year(endCell.Value) Then
                
                If ws.Cells(1, 4) = "" Then
                
                    ws.Cells(i, 4).Value = DateSerial(Year(currentDate), 12, 31)
                
                Else
                
                    ws.Cells(i, 4).End(xlUp).Offset(1, 0).Value = DateSerial(Year(currentDate), 12, 31)
                
                End If
                
            End If
            
            ' Insert beginning of next year
            
            currentDate = DateSerial(Year(currentDate) + 1, 1, 1)
            
            ' If the beginning of next year is before the end date, insert it
            
            If currentDate <= endCell.Value Then
                
                If ws.Cells(1, 3) = "" Then
                
                    ws.Cells(i, 3).Offset(1, 0).Value = currentDate
                
                Else
                
                    ws.Cells(i, 3).End(xlUp).Offset(1, 0).Value = currentDate
                
                End If
                
            End If
            
        Loop
       
        ' Insert the start date and label if it's not already inserted
        
            Debug.Print startCell.Value
        
        If ws.Cells(ws.Rows.Count, 3).End(xlUp).Value <> startCell.Value Then

                If ws.Cells(1, 3) = "" Then

                    ws.Cells(1, 3).Value = startCell.Value

                Else

                    ws.Cells(ws.Rows.Count, 3).End(xlUp).Offset(1, 0).Value = startCell.Value

                End If

        End If
        
        ' Insert the end date and label if it's not already inserted
        
        If ws.Cells(i, 4).End(xlUp).Value <> endCell.Value Then

                If ws.Cells(1, 4) = "" Then

                    ws.Cells(1, 4).Value = endCell.Value

                Else

                    ws.Cells(ws.Rows.Count, 4).End(xlUp).Offset(1, 0).Value = endCell.Value

                End If

        End If
        
    Next i
    
End Sub

But it doesn't work as I want.
 
Upvote 0
Turn it into a UDF to give you more flexibility.
VBA Code: 
Function GetDateSteps(startDate As Date, endDate As Date) As Variant
    Dim currentDate As Date
    Dim dateArray() As Date
    Dim i As Integer

    ' Initialize the output array with sufficient size (estimate 10 steps for simplicity)
    ReDim dateArray(1 To 10)
    i = 1
    
    ' Insert the start date
    dateArray(i) = startDate
    i = i + 1
    
    currentDate = startDate
    
    ' Insert dates between start and end dates
    Do While currentDate < endDate
        ' Insert end of year for the current year if end year is different
        If Year(currentDate) <> Year(endDate) Then
            If i > UBound(dateArray) Then
                ReDim Preserve dateArray(1 To i + 10)
            End If
            dateArray(i) = DateSerial(Year(currentDate), 12, 31)
            i = i + 1
        End If
        
        ' Insert beginning of next year
        currentDate = DateSerial(Year(currentDate) + 1, 1, 1)
        ' If the beginning of next year is before the end date, insert it
        If currentDate <= endDate Then
            If i > UBound(dateArray) Then
                ReDim Preserve dateArray(1 To i + 10)
            End If
            dateArray(i) = currentDate
            i = i + 1
        End If
    Loop
    
    ' Insert the end date
    If i > UBound(dateArray) Then
        ReDim Preserve dateArray(1 To i + 10)
    End If
    dateArray(i) = endDate
    
    ' Resize the array to the exact number of entries
    ReDim Preserve dateArray(1 To i)
    
    ' Transpose the array
    Dim transposedArray() As Variant
    ReDim transposedArray(1 To UBound(dateArray), 1 To 1)
    For j = 1 To UBound(dateArray)
        transposedArray(j, 1) = dateArray(j)
    Next j
    
    ' Return the transposed array
    GetDateSteps = transposedArray
End Function
Book1 (version 2).xlsb
ABCD
15/14/216/18/215/14/216/18/21
25/23/223/2/2312/31/2112/31/21
31/1/221/1/22
45/23/2212/31/22
51/1/23
63/2/23
Sheet1
Cell Formulas
RangeFormula
C1:C4,D1:D6C1=GetDateSteps(A1,A2)
Dynamic array formulas.
 
Upvote 1
Ok, this is going better. To refine it a bit more, I propose some improvements:

1. The ranges have to be two by two. That is, start and end in the same row. This makes it much easier for me to calculate the range in question later.

2. It could be set in such a way that instead of two cells, A1 and A2, it was a dynamic range and took all the ranges that there could be. Let me explain:

With the way the formula works right now, I can't create a list of date ranges downwards, because there will be date ranges with only one row and others with two or more rows. Look:

05/14/2021 06/18/2021 --> 1 row

05/23/2022 02/03/2023 --> 2 rows

Now, if I put another range below it, how do I do it? It's no longer proportional and I can't. I don't know if I'm explaining myself.

Nothing more, thank you very much.
 
Upvote 0
Try this subroutine. This takes in a column range of start/end date pairs and output to B1. Change sheet name as needed.

VBA Code: 
Sub AggregateDateSteps()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim inputRange As Range
    Dim outputRange As Range
    Dim startDate As Date
    Dim endDate As Date
    Dim dateSteps As Variant
    Dim resultArray() As Variant
    Dim totalSteps As Integer
    Dim currentStep As Integer
    Dim pairCount As Integer
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet2")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set inputRange = ws.Range("A1:A" & lastRow)
    Set outputRange = ws.Range("B1")
    
    ' Initialize variables
    pairCount = inputRange.Rows.Count / 2
    totalSteps = 0
    
    ' Loop through the provided range to calculate the total number of steps needed
    For i = 1 To pairCount
        startDate = inputRange.Cells((i - 1) * 2 + 1, 1).Value
        endDate = inputRange.Cells(i * 2, 1).Value
        
        ' Always account for the start date and end date
        If Year(startDate) <> Year(endDate) Then
            dateSteps = GetDateSteps(startDate, endDate)
            totalSteps = totalSteps + UBound(dateSteps, 1)
        Else
            totalSteps = totalSteps + 2 ' Start and end dates are in the same year
        End If
    Next i

    ReDim resultArray(1 To totalSteps, 1 To 1)
    
    ' Loop through the provided range again to populate the result array
    currentStep = 1
    For i = 1 To pairCount
        startDate = inputRange.Cells((i - 1) * 2 + 1, 1).Value
        endDate = inputRange.Cells(i * 2, 1).Value
        
        ' Always add the start date
        resultArray(currentStep, 1) = startDate
        currentStep = currentStep + 1
        
        ' Only call GetDateSteps if the year of startDate and endDate are not the same
        If Year(startDate) <> Year(endDate) Then
            dateSteps = GetDateSteps(startDate, endDate)
            
            ' Skip the first element (already added as startDate)
            For j = 2 To UBound(dateSteps, 1)
                resultArray(currentStep, 1) = dateSteps(j, 1)
                currentStep = currentStep + 1
            Next j
        Else
            ' Directly add the end date if start and end are in the same year
            resultArray(currentStep, 1) = endDate
            currentStep = currentStep + 1
        End If
    Next i
    
    ' Output the result array to the specified output range
    outputRange.Resize(totalSteps, 1).Value = resultArray
End Sub

Function GetDateSteps(startDate As Date, endDate As Date) As Variant
    Dim currentDate As Date
    Dim dateArray() As Date
    Dim i As Integer

    ' Initialize the output array with sufficient size (estimate 10 steps for simplicity)
    ReDim dateArray(1 To 10)
    i = 1
    
    ' Insert the start date
    dateArray(i) = startDate
    i = i + 1
    
    currentDate = startDate
    
    ' Insert dates between start and end dates
    Do While currentDate < endDate
        ' Insert end of year for the current year if end year is different
        If Year(currentDate) <> Year(endDate) Then
            If i > UBound(dateArray) Then
                ReDim Preserve dateArray(1 To i + 10)
            End If
            dateArray(i) = DateSerial(Year(currentDate), 12, 31)
            i = i + 1
        End If
        
        ' Insert beginning of next year
        currentDate = DateSerial(Year(currentDate) + 1, 1, 1)
        ' If the beginning of next year is before the end date, insert it
        If currentDate <= endDate Then
            If i > UBound(dateArray) Then
                ReDim Preserve dateArray(1 To i + 10)
            End If
            dateArray(i) = currentDate
            i = i + 1
        End If
    Loop
    
    ' Insert the end date
    If i > UBound(dateArray) Then
        ReDim Preserve dateArray(1 To i + 10)
    End If
    dateArray(i) = endDate
    
    ' Resize the array to the exact number of entries
    ReDim Preserve dateArray(1 To i)
    
    ' Transpose the array
    Dim transposedArray() As Variant
    ReDim transposedArray(1 To UBound(dateArray), 1 To 1)
    For j = 1 To UBound(dateArray)
        transposedArray(j, 1) = dateArray(j)
    Next j
    
    ' Return the transposed array
    GetDateSteps = transposedArray
End Function
Book1
AB
15/14/215/14/21
210/23/2312/31/21
36/18/241/1/22
412/2/2412/31/22
51/1/23
610/23/23
76/18/24
812/2/24
Sheet2
 
Upvote 1
You're going to hate me, but I appreciate what you're giving me. The only problem is that I can't make you see what I want. Let's see now:

In this example I'll show you what I want to achieve.

You have columns A and B with some sample data that I will always fill in. In columns C and D you can see the result that should be given. I have marked the breakdown of each date with colors.

As you can see, I have entered 5 records (or rows), but in the output range I see 8 because there are records (or rows) that cover several years, and hence there are more records or rows of output or input.

With this layout, I can perfectly do my calculations.

1717560877191.png
 
Upvote 0
It's an easy fix with the built-in WRAPROWS(). Have your start/end in a single column.
VBA Code: 
Function AggregateDateSteps(inputRange As Range) As Variant
    Dim pairCount As Integer
    Dim totalSteps As Integer
    Dim resultArray() As Variant
    Dim currentStep As Integer
    Dim i As Integer
    Dim startDate As Date
    Dim endDate As Date
    Dim dateSteps As Variant
   
    ' Initialize variables
    pairCount = inputRange.Rows.Count / 2
    totalSteps = 0
   
    ' Loop through the provided range to calculate the total number of steps needed
    For i = 1 To pairCount
        startDate = inputRange.Cells((i - 1) * 2 + 1, 1).Value
        endDate = inputRange.Cells(i * 2, 1).Value
       
        ' Always account for the start date and end date
        If Year(startDate) <> Year(endDate) Then
            dateSteps = GetDateSteps(startDate, endDate)
            totalSteps = totalSteps + UBound(dateSteps, 1)
        Else
            totalSteps = totalSteps + 2 ' Start and end dates are in the same year
        End If
    Next i

    ReDim resultArray(1 To totalSteps, 1 To 1)
   
    ' Loop through the provided range again to populate the result array
    currentStep = 1
    For i = 1 To pairCount
        startDate = inputRange.Cells((i - 1) * 2 + 1, 1).Value
        endDate = inputRange.Cells(i * 2, 1).Value
       
        ' Always add the start date
        resultArray(currentStep, 1) = startDate
        currentStep = currentStep + 1
       
        ' Only call GetDateSteps if the year of startDate and endDate are not the same
        If Year(startDate) <> Year(endDate) Then
            dateSteps = GetDateSteps(startDate, endDate)
           
            ' Skip the first element (already added as startDate)
            For j = 2 To UBound(dateSteps, 1)
                resultArray(currentStep, 1) = dateSteps(j, 1)
                currentStep = currentStep + 1
            Next j
        Else
            ' Directly add the end date if start and end are in the same year
            resultArray(currentStep, 1) = endDate
            currentStep = currentStep + 1
        End If
    Next i
   
    ' Return the result array
    AggregateDateSteps = resultArray
End Function
Book1
ABC
15/14/215/14/2112/31/21
210/23/231/1/2212/31/22
36/18/241/1/2310/23/23
412/2/246/18/2412/2/24
Sheet8
Cell Formulas
RangeFormula
B1:C4B1=WRAPROWS(AggregateDateSteps(A1:A4),2)
Dynamic array formulas.
 
Upvote 1
You must log in or register to reply here.

Similar threads

G
  • Question Question
What dates are the first zero, and the first non-zero after a specified date
Replies
8
Views
398
gooniegirl180
G
G
  • Locked
  • Question Question
VBA Userform - Change from 1900 Date Format to Long Date
Replies
1
Views
58
Peter_SSs
Peter_SSs
G
  • Question Question
VBA Userform Date Format
Replies
7
Views
182
gilly01625
G
D
  • Question Question
Calculating a YTD Balance based on end date?
Replies
2
Views
79
des378
D
G
  • Question Question
Format Pulled Data from Workbook into a Text Box
Replies
3
Views
47
Skyybot
Skyybot

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top