Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim OriginalEndingDate As String
OriginalEndingDate = "X7" ' <--- Set this to the address contining the Week Ending Date
'
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
'
If Not Intersect(Target, Range(OriginalEndingDate)) Is Nothing Then
'
Dim BeginDate As Date
Dim DateIncrementer As Long
Dim DaysRow As Long
Dim FirstStartDaysColumn As String, SecondStartDaysColumn As String, ThirdStartDaysColumn As String
'
FirstStartDaysColumn = "Y" ' <--- set this to the start column of the first set of days
SecondStartDaysColumn = "AP" ' <--- set this to the start column of the second set of days
ThirdStartDaysColumn = "BH" ' <--- set this to the start column of the third set of days
DaysRow = 14 ' <--- Set this to the row for displaying the days generated
'
'
'
BeginDate = DateAdd("d", -6, CStr(Range(OriginalEndingDate))) ' Calculate the Beginning Date to enable day incrementing
'
For DateIncrementer = 0 To 20 ' Loop to increment the sets of Days
Select Case DateIncrementer
Case Is < 7 ' Display the first 7 days
Cells(DaysRow, Range(FirstStartDaysColumn & 1).Column + DateIncrementer) = Day(DateAdd("d", DateIncrementer, CStr(BeginDate)))
Case 7 To 13 ' Display the second 7 days
Cells(DaysRow, Range(SecondStartDaysColumn & 1).Column - 7 + DateIncrementer) = Day(DateAdd("d", DateIncrementer, CStr(BeginDate)))
Case 14 To 20 ' Display the third 7 days
Cells(DaysRow, Range(ThirdStartDaysColumn & 1).Column - 14 + DateIncrementer) = Day(DateAdd("d", DateIncrementer, CStr(BeginDate)))
End Select
Next
End If
End Sub