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
