Generate dates in each row between two dates in Excel

Generating Dates Between Dates

• The following does not account for 'surprises', e.g. a date is a string, a date is missing, start date is greater than end date, a row is empty, a worksheet is missing, there is no data...
• Adjust the values in the constants section before using the code.

The Code

Option Explicit

Sub generateDates()
    
    ' Define constants.
    
    ' Source
    Const SourceWorksheetName As String = "Sheet1"
    Const SourceFirstCellRange As String = "A1"
    ' Target
    Const TargetWorksheetName As String = "Sheet1"
    Const TargetFirstCellRange As String = "E1"
    Const FourthTargetColumnTitle As String = "Dates"
    ' Workbook
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    ' Define Source Range.
    
    Dim cel As Range
    Set cel = wb.Worksheets(SourceWorksheetName).Range(SourceFirstCellRange)
    
    Dim rng As Range
    With cel.CurrentRegion
        Set rng = cel.Resize(.Rows.Count + .Row - cel.Row, _
            .Columns.Count + .Column - cel.Column)
    End With
    
    ' Write values from Source Range to Source Array.
    
    Dim Source As Variant
    Source = rng.Value
    
    ' Calculate the number of days for each date difference in Source Array
    ' and write the results to Days Count Array.
    
    Dim NoP As Long ' Number of Products
    NoP = UBound(Source, 1)
    
    Dim DaysCount As Variant
    ReDim DaysCount(2 To NoP)
    
    Dim i As Long ' Source Array Rows Counter
    For i = 2 To NoP
        DaysCount(i) = Source(i, 3) - Source(i, 2) + 1
    Next i
    
    ' Write values from Source Array and generates values to Target Array.
    
    Dim Target As Variant ' '1 +' is for headers.
    ReDim Target(1 To 1 + Application.Sum(DaysCount), 1 To 4)
    
    Dim j As Long ' First Three Columns Counter
    For j = 1 To 3
        Target(1, j) = Source(1, j)
    Next j
    Target(1, 4) = FourthTargetColumnTitle
    
    Dim k As Long ' Days Counter
    Dim m As Long ' Target Array Rows Counter
    m = 1 ' because of header
    For i = 2 To NoP
        For k = 1 To DaysCount(i)
            m = m + 1
            For j = 1 To 3
                Target(m, j) = Source(i, j)
            Next j
            Target(m, 4) = Source(i, 2) + k - 1
        Next k
    Next i
    
    ' Write values from Target Array to Target Range.
    
    With wb.Worksheets(TargetWorksheetName).Range(TargetFirstCellRange)
        With .Resize(, UBound(Target, 2)) ' first row
            .Resize(.Worksheet.Rows.Count - .Row + 1).ClearContents
            .Resize(UBound(Target, 1)) = Target
        End With
    End With

End Sub

This script is far from perfect, it takes quite a long time on hundreds of records, but in the end it does what is required:

Sub extandDates()
Dim rSource As Range
Dim rRow As Range
Dim rTarget As Range
Dim dNext As Double
Application.ScreenUpdating = False
    Set rSource = ActiveSheet.UsedRange
    Set rSource = rSource.Resize(, 3)
    Set rTarget = rSource.Offset(0, rSource.Columns.Count + 2).Resize(1, 4)
    rTarget.Value = Array("Product", "Date In", "Date Out", "Dates")
    Set rTarget = rTarget.Offset(1, 0)
    Set rSource = rSource.Resize(, 1).Offset(1, 0)
    rTarget.Offset(0, 3).Resize(1, 1).EntireColumn.NumberFormat = _
             rSource.Resize(1, 1).Offset(0, 2).NumberFormat
    For Each rRow In rSource.Cells
        For dNext = rRow.Offset(0, 1).Value2 To rRow.Offset(0, 2).Value2
            rRow.Resize(1, 3).Copy Destination:=rTarget
            rTarget.Offset(0, 3).Resize(1, 1).Value2 = dNext
            Set rTarget = rTarget.Offset(1, 0)
        Next dNext
    Next rRow
Application.ScreenUpdating = True
End Sub