Excel VBA Date Generation Loop - vba

Question

I have a sheet i am working on that i need to populate all the days between 2 dates for a month 54 times.
I have got together a loop that can do this for the first section - I now need ti replicated 54 times.
I have figured out a loop to copy and paste this range the 54 times which works as it should. however I am wondering whether there is a way to put the date generation loop inside the duplication loop and generate every date rather than copy and paste?
I am mainly looking for the most efficient method as this will potentially be scaled up in future so any pointers with my code would be greatly appreciated.
Sub WriteDatesLoopTest()
'Disables Screen Flickering on Copy/Paste
Application.ScreenUpdating = False
OffsetValue = 42
'----------------------------------------------
Dim StartDate As Range
Dim EndDate As Range
Dim OutputRange As Range
Dim ClearRange As Range
Dim StartValue As Variant
Dim EndValue As Variant
Dim DateRangeCopy As Range
Dim EmployeeCount As Range
Dim MonthValue As Range
'----------------------------------------------
Set ClearRange = Range("A9:A39")
Set StartDate = Range("T4")
Set EndDate = Range("T5")
Set OutputRange = Range("A9")
Set DateRangeCopy = Range("A9:A39")
Set EmployeeCount = Range("O1")
Set MonthValue = Range("J1")
StartValue = StartDate
EndValue = EndDate
'----------Date Generation Loop----------------
If EndValue - StartValue <= 0 Then
Exit Sub
End If
ColIndex = 0
For i = StartValue To EndValue
OutputRange.Offset(ColIndex, 0) = i
ColIndex = ColIndex + 1
Next
'----------Copy & Paste------------------------
n = EmployeeCount
For j = 0 To (n - 1)
'ClearRange.Offset(OffsetValue * j, 0).ClearContents
DateRangeCopy.Copy
With DateRangeCopy.Offset(OffsetValue * j, 0)
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
SkipBlanks = False
End With
'Show Status Bar in Bottom Left
Application.StatusBar = "Progress: " & Format(j / n, "0%")
Next
'Display Message on completion
MsgBox "Dates Generated"
'Removes 'Walking Ants' From copied selection
Application.CutCopyMode = False
'Enables Screen Flickering on Copy/Paste
Application.ScreenUpdating = True
'Reset Status Bar in Bottom Left
Application.StatusBar = False
'-----------------------------------
End Sub
Thank you

Answer 1

Just seen the comments. Yes Code Review would be good. You probably want to move the entire process into an array.
This demonstrates all the required elements.
Option Explicit
Public Sub GenerateDates()
Const LOOPCOUNT As Long = 54
Dim i As Long, j As Long
Dim startDate As Long, endDate As Long, rowCounter As Long
startDate = CLng(Now)
endDate = startDate + 7
Application.ScreenUpdating = False
With ActiveSheet
For i = 1 To LOOPCOUNT
For j = startDate To endDate
rowCounter = rowCounter + 1
.Cells(rowCounter, 1) = j
Next j
rowCounter = rowCounter + 5 '<== Add gap
Next i
.Columns("A").NumberFormat = "m/d/yyyy"
End With
Application.ScreenUpdating = True
End Sub
Doing the same thing in memory (I have included a second dimension as you may have additional columns in your data. My principle was really about showing the dates increment with row gap.)
Option Explicit
Public Sub GenerateDates() '697
Const LOOPCOUNT As Long = 54
Dim i As Long, j As Long
Dim startDate As Long, endDate As Long, rowCounter As Long
startDate = CLng(Now)
endDate = startDate + 7
Dim ROWGAP As Long: ROWGAP = 41-(Enddate-StartDate)
Dim outputArr()
ReDim outputArr(1 To (((endDate - startDate + 1) + ROWGAP) * LOOPCOUNT) - ROWGAP, 1 To 1)
Application.ScreenUpdating = False
With ActiveSheet
For i = 1 To LOOPCOUNT
For j = startDate To endDate
rowCounter = rowCounter + 1
outputArr(rowCounter, 1) = j
Next j
rowCounter = rowCounter + ROWGAP '<== Add gap
Next i
.Cells(1, 1).Resize(UBound(outputArr), UBound(outputArr, 2)) = outputArr 'This is only with one dimensional
.Columns("A").NumberFormat = "m/d/yyyy"
End With
Application.ScreenUpdating = True
End Sub
tl;dr;
The principle is basically that you want an outer loop that increments from 1 to 54. Then an inner loop that increments from start date to end date. I treat date as a Long and simply add one to the startDate until I reach the endDate in the inner loop. For i = 1 To LOOPCOUNT is doing the repeat work... here you could be using your copy paste. I increment the rowCounter variable by 5 before the next repeat to leave some blank rows between repeats.
The first version writes to the sheet for every row with .Cells(rowCounter, 1) = j . That is an expensive operation "touching" the sheet each time. The second version does the same process but doesn't write to the sheet until the very end. Instead, it writes to an array. This is much faster as is all done in memory (no going to disk).
I know how many rows I will have in the array because I know how many times I am repeating the entire process (54), the number of days from startDate and endDate (8) and the number of padding rows I am adding (5). So I can size my array to write to with ReDim outputArr(1 To (((endDate - startDate + 1) + ROWGAP) * LOOPCOUNT) - ROWGAP, 1 To 1). I don't need 5 rows padding on the 54th loop so I remove these from the total row count.
For understanding working with arrays and data in the worksheet the article VBA Arrays And Worksheet Ranges is worth a read, a long with the more general VBA Arrays

Answer 2

The fewer tasks that a subroutine performs, the easier it is to write, test, and modify. For this reason I created a function to generate the output Array.
OffsetValue has a somewhat ambiguous name. I used SectionLength instead.
Sub AddDates()
Const OffsetValue = 42
Dim data() As Variant
data = getDatesArray(#6/1/2018#, #6/30/2018#)
With Worksheets("Sheet1")
.Columns(1).ClearContents
.Range("A1").Resize(UBound(data)).Value = data
End With
End Sub
Function getDatesArray(StartDate As Date, EndDate As Date, Optional SectionLength As Long = 42, Optional RepeatCount As Long = 54) As Variant()
Dim results() As Variant
Dim count As Long, n As Long
ReDim results(1 To SectionLength * RepeatCount, 1 To 1)
If EndDate >= StartDate Then
Do
count = count + 1
For n = 0 To UBound(results) - SectionLength Step SectionLength
results(n + count, 1) = StartDate
Next
StartDate = StartDate + 1
Loop Until StartDate = EndDate
End If
getDatesArray = results
End Function