See if the attached works for you. It work well with the limited data in the schedule, though I had to change the date on the Monday sheet to get a valid date contained in the data.
Based on your sample workbook, the Monday sheet is the "date entry" sheet and dates in all other sheets are incremented accordingly.
The code is set up to runs as follows:
When the date is changed on the Monday sheet, then the schedule is filtered and applicable entries are copied to the Monday Sheet. On all subsequent sheets, just activating the sheet will run the code to filter and copy entries. If you want manual execution of the code, then the macro could be assigned to a button on each sheet, which requires removal of the code from the worksheet modules.
Option Explicit
Sub Parse_Schedule()
Dim ws As Worksheet, rngCriteria As Range
Dim lrow As Long: lrow = Cells(Rows.Count, 1).End(xlUp).Row
If lrow < 10 Then lrow = 10
Select Case ActiveSheet.Name
Case "Monday": Set ws = Sheet1
Case "Tuesday": Set ws = Sheet2
Case "Wednesday": Set ws = Sheet3
Case "Thursday": Set ws = Sheet4
Case "Friday": Set ws = Sheet5
Case "Saturday": Set ws = Sheet6
Case "Sunday": Set ws = Sheet7
End Select
Application.ScreenUpdating = False
'establish criteria for the Advanced Filter
Sheet8.Range("Z1").Value = "Schedule"
Sheet8.Range("Z2").Value = ws.Range("G1").Value
Set rngCriteria = Sheet8.Range("Z1:Z2")
'clear existing contents in preparation for updated schedule items
With ws
.Range("A10:D" & lrow).ClearContents
End With
With Sheet8
'remove any existing filters
If .AutoFilterMode = True Then .AutoFilterMode = False
'apply advanced filter
.Range("A1").CurrentRegion.AdvancedFilter xlFilterInPlace, criteriarange:=rngCriteria, Unique:=False
'copy the filters cells to sheet2
.Range("A1").CurrentRegion.Resize(, 4).Offset(1, 0).Copy ws.Range("A" & lrow)
'turn off filtering
.ShowAllData
End With
'clear the clipboard
Application.CutCopyMode = False
Application.ScreenUpdating = True
'reset variables to nothing
Set rngCriteria = Nothing
Set ws = Nothing
End Sub
Code for "Monday" sheet
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G1")) Is Nothing Then Call Parse_Schedule
End Sub
Private Sub Worksheet_Activate()
Call Parse_Schedule
End Sub
Code for all other sheet module (except "Schedule")
Private Sub Worksheet_Activate()
Call Parse_Schedule
End Sub
Bookmarks