From c2ec1021443f51e66d343fe5f0ae912cda92619c Mon Sep 17 00:00:00 2001 From: Casielim Date: Sun, 6 Jul 2025 00:55:35 +0800 Subject: [PATCH 1/6] Add 'CLOSED' for Sun and holiday --- .../AssignEmployeeMain.bas | 68 +++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas diff --git a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas new file mode 100644 index 0000000..27f6595 --- /dev/null +++ b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas @@ -0,0 +1,68 @@ +Attribute VB_Name = "AssignEmployeeMain" +'declare worksheet and table + Private wsRosterCopy As Worksheet + Private wsPersonnel As Worksheet + Private wsSettings As Worksheet + Private morningtbl As ListObject + Private spectbl As ListObject + +'declare roster column number + Private Const VAC_COL As Long = 1 + Private Const DATE_COL As Long = 2 + Private Const DAY_COL As Long = 3 + Private Const LMB_COL As Long = 4 + Private Const MOR_COL As Long = 6 + Private Const AFT_COL As Long = 8 + Private Const AOH_COL As Long = 10 + Private Const SAT_AOH_COL1 As Long = 12 + Private Const SAT_AOH_COL2 As Long = 14 + Private Const START_ROW As Long = 6 + +Sub Main() + Set wsRosterCopy = Sheets("MasterCopy (2)") + Set wsSettings = Sheets("Settings") + + Dim currDate As Date + + If wsRosterCopy.Cells(2, 10).Value = "Jan-Jun" And wsRosterCopy.Cells(2, 13).Value Mod 4 = 0 Then + lastRowRoster = 187 + ElseIf wsRosterCopy.Cells(2, 10).Value = "Jan-Jun" Then + lastRowRoster = 186 + Else + lastRowRoster = 189 + End If + + 'Loop through each date row + For dateRow = 6 To lastRowRoster + + currDate = wsRosterCopy.Cells(dateRow, DATE_COL).Value + + If Weekday(currDate, vbMonday) = 7 Or _ + Application.WorksheetFunction.CountIf(wsSettings.Range("Settings_Holidays"), currDate) > 0 Then + + ' Skip this date by marking all slots as "CLOSED" + wsRosterCopy.Cells(dateRow, LMB_COL).Value = "CLOSED" ' D column + wsRosterCopy.Cells(dateRow, LMB_COL).Interior.Color = vbRed + + wsRosterCopy.Cells(dateRow, MOR_COL).Value = "CLOSED" ' F column + wsRosterCopy.Cells(dateRow, MOR_COL).Interior.Color = vbRed + + wsRosterCopy.Cells(dateRow, AFT_COL).Value = "CLOSED" ' H column + wsRosterCopy.Cells(dateRow, AFT_COL).Interior.Color = vbRed + + wsRosterCopy.Cells(dateRow, AOH_COL).Value = "CLOSED" ' J column + wsRosterCopy.Cells(dateRow, AOH_COL).Interior.Color = vbRed + + wsRosterCopy.Cells(dateRow, SAT_AOH_COL1).Value = "CLOSED" ' L column + wsRosterCopy.Cells(dateRow, SAT_AOH_COL1).Interior.Color = vbRed + + wsRosterCopy.Cells(dateRow, SAT_AOH_COL2).Value = "CLOSED" ' N column + wsRosterCopy.Cells(dateRow, SAT_AOH_COL2).Interior.Color = vbRed + GoTo NextDate ' Skip to the next date + End If + +NextDate: + Next dateRow + +End Sub + From 65b5362ac10d6590727681eb451fb283507c09f3 Mon Sep 17 00:00:00 2001 From: Casielim Date: Mon, 7 Jul 2025 13:43:03 +0800 Subject: [PATCH 2/6] Call AssignMorningDuties --- VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas | 1 + 1 file changed, 1 insertion(+) diff --git a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas index 27f6595..caff539 100644 --- a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas +++ b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas @@ -64,5 +64,6 @@ Sub Main() NextDate: Next dateRow + Call AssignMorningDuties.AssignMorningDuties End Sub From b651f5574d1309e1c6c778d35ecf5924f9f255e8 Mon Sep 17 00:00:00 2001 From: Casielim Date: Tue, 8 Jul 2025 22:57:11 +0800 Subject: [PATCH 3/6] Declare global variable LAST_ROW_ROSTER --- VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas index caff539..c736f01 100644 --- a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas +++ b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas @@ -1,4 +1,7 @@ Attribute VB_Name = "AssignEmployeeMain" +'global variable + Public LAST_ROW_ROSTER As Long + 'declare worksheet and table Private wsRosterCopy As Worksheet Private wsPersonnel As Worksheet @@ -25,15 +28,15 @@ Sub Main() Dim currDate As Date If wsRosterCopy.Cells(2, 10).Value = "Jan-Jun" And wsRosterCopy.Cells(2, 13).Value Mod 4 = 0 Then - lastRowRoster = 187 + LAST_ROW_ROSTER = 187 ElseIf wsRosterCopy.Cells(2, 10).Value = "Jan-Jun" Then - lastRowRoster = 186 + LAST_ROW_ROSTER = 186 Else - lastRowRoster = 189 + LAST_ROW_ROSTER = 189 End If 'Loop through each date row - For dateRow = 6 To lastRowRoster + For dateRow = 6 To LAST_ROW_ROSTER currDate = wsRosterCopy.Cells(dateRow, DATE_COL).Value From a3b10a9ca973f5336e36f0a40b905987b7c05f2b Mon Sep 17 00:00:00 2001 From: Casielim Date: Fri, 18 Jul 2025 14:14:02 +0800 Subject: [PATCH 4/6] Make column variables public and improve code quality --- .../AssignEmployeeMain.bas | 98 +++++++++++-------- 1 file changed, 57 insertions(+), 41 deletions(-) diff --git a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas index c736f01..96439d2 100644 --- a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas +++ b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas @@ -1,72 +1,88 @@ Attribute VB_Name = "AssignEmployeeMain" -'global variable - Public LAST_ROW_ROSTER As Long - -'declare worksheet and table - Private wsRosterCopy As Worksheet - Private wsPersonnel As Worksheet - Private wsSettings As Worksheet - Private morningtbl As ListObject - Private spectbl As ListObject - -'declare roster column number - Private Const VAC_COL As Long = 1 - Private Const DATE_COL As Long = 2 - Private Const DAY_COL As Long = 3 - Private Const LMB_COL As Long = 4 - Private Const MOR_COL As Long = 6 - Private Const AFT_COL As Long = 8 - Private Const AOH_COL As Long = 10 - Private Const SAT_AOH_COL1 As Long = 12 - Private Const SAT_AOH_COL2 As Long = 14 - Private Const START_ROW As Long = 6 - +' Global variable +Public LAST_ROW_ROSTER As Long +Public wsRoster As Worksheet +Public wsSettings As Worksheet + +' Declare roster column numbers +Public Const VAC_COL As Long = 1 +Public Const DATE_COL As Long = 2 +Public Const DAY_COL As Long = 3 +Public Const LMB_COL As Long = 4 +Public Const MOR_COL As Long = 6 +Public Const AFT_COL As Long = 8 +Public Const AOH_COL As Long = 10 +Public Const SAT_AOH_COL1 As Long = 12 +Public Const SAT_AOH_COL2 As Long = 14 +Public Const START_ROW As Long = 6 + +' Declare worksheet and table +Private wsPersonnel As Worksheet +Private morningtbl As ListObject +Private spectbl As ListObject + Sub Main() - Set wsRosterCopy = Sheets("MasterCopy (2)") +Attribute Main.VB_ProcData.VB_Invoke_Func = "M\n14" + Set wsRoster = Sheets("MasterCopy (2)") Set wsSettings = Sheets("Settings") Dim currDate As Date - If wsRosterCopy.Cells(2, 10).Value = "Jan-Jun" And wsRosterCopy.Cells(2, 13).Value Mod 4 = 0 Then + If wsRoster.Cells(2, 10).Value = "Jan-Jun" And wsRoster.Cells(2, 13).Value Mod 4 = 0 Then LAST_ROW_ROSTER = 187 - ElseIf wsRosterCopy.Cells(2, 10).Value = "Jan-Jun" Then + ElseIf wsRoster.Cells(2, 10).Value = "Jan-Jun" Then LAST_ROW_ROSTER = 186 Else LAST_ROW_ROSTER = 189 End If - 'Loop through each date row - For dateRow = 6 To LAST_ROW_ROSTER - - currDate = wsRosterCopy.Cells(dateRow, DATE_COL).Value + ' Loop through each date row + For dateRow = START_ROW To LAST_ROW_ROSTER + ' Reset formatting for all slots + Dim slotCol As Variant + For Each slotCol In Array(LMB_COL, MOR_COL, AFT_COL, AOH_COL, SAT_AOH_COL1, SAT_AOH_COL2) + Dim slotCell As Range + Set slotCell = wsRoster.Cells(dateRow, slotCol) + slotCell.Interior.ColorIndex = xlNone ' Reset to no fill (default) + slotCell.Font.Strikethrough = False + Next slotCol + + currDate = wsRoster.Cells(dateRow, DATE_COL).Value If Weekday(currDate, vbMonday) = 7 Or _ Application.WorksheetFunction.CountIf(wsSettings.Range("Settings_Holidays"), currDate) > 0 Then ' Skip this date by marking all slots as "CLOSED" - wsRosterCopy.Cells(dateRow, LMB_COL).Value = "CLOSED" ' D column - wsRosterCopy.Cells(dateRow, LMB_COL).Interior.Color = vbRed + wsRoster.Cells(dateRow, LMB_COL).Value = "CLOSED" ' D column + wsRoster.Cells(dateRow, LMB_COL).Interior.Color = vbRed - wsRosterCopy.Cells(dateRow, MOR_COL).Value = "CLOSED" ' F column - wsRosterCopy.Cells(dateRow, MOR_COL).Interior.Color = vbRed + wsRoster.Cells(dateRow, MOR_COL).Value = "CLOSED" ' F column + wsRoster.Cells(dateRow, MOR_COL).Interior.Color = vbRed - wsRosterCopy.Cells(dateRow, AFT_COL).Value = "CLOSED" ' H column - wsRosterCopy.Cells(dateRow, AFT_COL).Interior.Color = vbRed + wsRoster.Cells(dateRow, AFT_COL).Value = "CLOSED" ' H column + wsRoster.Cells(dateRow, AFT_COL).Interior.Color = vbRed - wsRosterCopy.Cells(dateRow, AOH_COL).Value = "CLOSED" ' J column - wsRosterCopy.Cells(dateRow, AOH_COL).Interior.Color = vbRed + wsRoster.Cells(dateRow, AOH_COL).Value = "CLOSED" ' J column + wsRoster.Cells(dateRow, AOH_COL).Interior.Color = vbRed - wsRosterCopy.Cells(dateRow, SAT_AOH_COL1).Value = "CLOSED" ' L column - wsRosterCopy.Cells(dateRow, SAT_AOH_COL1).Interior.Color = vbRed + wsRoster.Cells(dateRow, SAT_AOH_COL1).Value = "CLOSED" ' L column + wsRoster.Cells(dateRow, SAT_AOH_COL1).Interior.Color = vbRed - wsRosterCopy.Cells(dateRow, SAT_AOH_COL2).Value = "CLOSED" ' N column - wsRosterCopy.Cells(dateRow, SAT_AOH_COL2).Interior.Color = vbRed + wsRoster.Cells(dateRow, SAT_AOH_COL2).Value = "CLOSED" ' N column + wsRoster.Cells(dateRow, SAT_AOH_COL2).Interior.Color = vbRed GoTo NextDate ' Skip to the next date End If NextDate: Next dateRow + + Call AssignSatAOHDuties.AssignSatAOHDuties + Call AssignAOHDuties.AssignAOHDuties + Call AssignAfternoonDuties.AssignAfternoonDuties Call AssignMorningDuties.AssignMorningDuties + Call AssignLoanMailBoxDuties.AssignLoanMailBoxDuties + + Call DuplicateSystemRoster.DuplicateSystemRoster End Sub From d9dabbd50af5212161f17812c54dfdaa693902b9 Mon Sep 17 00:00:00 2001 From: Casielim Date: Sat, 19 Jul 2025 00:15:14 +0800 Subject: [PATCH 5/6] Improve code quality --- .../AssignEmployeeMain.bas | 56 ++++++++----------- 1 file changed, 24 insertions(+), 32 deletions(-) diff --git a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas index 96439d2..09dacce 100644 --- a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas +++ b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas @@ -16,18 +16,17 @@ Public Const SAT_AOH_COL1 As Long = 12 Public Const SAT_AOH_COL2 As Long = 14 Public Const START_ROW As Long = 6 -' Declare worksheet and table -Private wsPersonnel As Worksheet -Private morningtbl As ListObject -Private spectbl As ListObject - Sub Main() Attribute Main.VB_ProcData.VB_Invoke_Func = "M\n14" Set wsRoster = Sheets("MasterCopy (2)") Set wsSettings = Sheets("Settings") + Dim dateRow As Long Dim currDate As Date + Dim slotCol As Variant + Dim slotCell As Range + 'Find last row of roster If wsRoster.Cells(2, 10).Value = "Jan-Jun" And wsRoster.Cells(2, 13).Value Mod 4 = 0 Then LAST_ROW_ROSTER = 187 ElseIf wsRoster.Cells(2, 10).Value = "Jan-Jun" Then @@ -38,44 +37,22 @@ Attribute Main.VB_ProcData.VB_Invoke_Func = "M\n14" ' Loop through each date row For dateRow = START_ROW To LAST_ROW_ROSTER + currDate = wsRoster.Cells(dateRow, DATE_COL).Value ' Reset formatting for all slots - Dim slotCol As Variant For Each slotCol In Array(LMB_COL, MOR_COL, AFT_COL, AOH_COL, SAT_AOH_COL1, SAT_AOH_COL2) - Dim slotCell As Range Set slotCell = wsRoster.Cells(dateRow, slotCol) slotCell.Interior.ColorIndex = xlNone ' Reset to no fill (default) slotCell.Font.Strikethrough = False Next slotCol - currDate = wsRoster.Cells(dateRow, DATE_COL).Value - - If Weekday(currDate, vbMonday) = 7 Or _ - Application.WorksheetFunction.CountIf(wsSettings.Range("Settings_Holidays"), currDate) > 0 Then - - ' Skip this date by marking all slots as "CLOSED" - wsRoster.Cells(dateRow, LMB_COL).Value = "CLOSED" ' D column - wsRoster.Cells(dateRow, LMB_COL).Interior.Color = vbRed - - wsRoster.Cells(dateRow, MOR_COL).Value = "CLOSED" ' F column - wsRoster.Cells(dateRow, MOR_COL).Interior.Color = vbRed - - wsRoster.Cells(dateRow, AFT_COL).Value = "CLOSED" ' H column - wsRoster.Cells(dateRow, AFT_COL).Interior.Color = vbRed - - wsRoster.Cells(dateRow, AOH_COL).Value = "CLOSED" ' J column - wsRoster.Cells(dateRow, AOH_COL).Interior.Color = vbRed - - wsRoster.Cells(dateRow, SAT_AOH_COL1).Value = "CLOSED" ' L column - wsRoster.Cells(dateRow, SAT_AOH_COL1).Interior.Color = vbRed - - wsRoster.Cells(dateRow, SAT_AOH_COL2).Value = "CLOSED" ' N column - wsRoster.Cells(dateRow, SAT_AOH_COL2).Interior.Color = vbRed - GoTo NextDate ' Skip to the next date + 'Check for Closed date + If IsClosedDay(currDate) Then + Call MarkAllSlotsClosed(dateRow) End If -NextDate: Next dateRow + 'Call ResetAllCounters.ResetAllCounters Call AssignSatAOHDuties.AssignSatAOHDuties Call AssignAOHDuties.AssignAOHDuties @@ -86,3 +63,18 @@ NextDate: Call DuplicateSystemRoster.DuplicateSystemRoster End Sub +Function IsClosedDate(currDate As Date) As Boolean + IsClosedDate = (Weekday(currDate, vbMonday) = 7) Or _ + Application.WorksheetFunction.CountIf(wsSettings.Range("Settings_Holidays"), currDate) > 0 +End Function + +Sub MarkAllSlotsClosed(dateRow As Long) + Dim col As Variant + For Each col In Array(LMB_COL, MOR_COL, AFT_COL, AOH_COL, SAT_AOH_COL1, SAT_AOH_COL2) + With wsRoster.Cells(dateRow, col) + .Value = "CLOSED" + .Interior.Color = vbRed + End With + Next col +End Sub + From 6097f4391c1924319160343390996fe1a285459f Mon Sep 17 00:00:00 2001 From: Casielim Date: Thu, 31 Jul 2025 22:30:41 +0800 Subject: [PATCH 6/6] Protect roster sheet --- .../AssignEmployeeMain.bas | 91 +++++++++++++++++-- 1 file changed, 81 insertions(+), 10 deletions(-) diff --git a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas index 09dacce..50f68c9 100644 --- a/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas +++ b/VBA/VBA-Code_By_Modules/AssignEmployeeMain.bas @@ -1,6 +1,6 @@ Attribute VB_Name = "AssignEmployeeMain" ' Global variable -Public LAST_ROW_ROSTER As Long +Public last_row_roster As Long Public wsRoster As Worksheet Public wsSettings As Worksheet @@ -18,25 +18,71 @@ Public Const START_ROW As Long = 6 Sub Main() Attribute Main.VB_ProcData.VB_Invoke_Func = "M\n14" - Set wsRoster = Sheets("MasterCopy (2)") + Set wsRoster = Sheets("Roster") Set wsSettings = Sheets("Settings") Dim dateRow As Long Dim currDate As Date Dim slotCol As Variant Dim slotCell As Range + Dim enteredPassword As String + Const password As String = "rostering2025" + + enteredPassword = InputBox("Please enter the password for roster population:", "Password Authentication") + If enteredPassword <> password Then + MsgBox "Incorrect password. Fail to populate roster.", vbCritical + Exit Sub + End If 'Find last row of roster If wsRoster.Cells(2, 10).Value = "Jan-Jun" And wsRoster.Cells(2, 13).Value Mod 4 = 0 Then - LAST_ROW_ROSTER = 187 + last_row_roster = 187 ElseIf wsRoster.Cells(2, 10).Value = "Jan-Jun" Then - LAST_ROW_ROSTER = 186 + last_row_roster = 186 Else - LAST_ROW_ROSTER = 189 + last_row_roster = 189 + End If + + + ' Define your table and corresponding sheet names + sheetNames = Array("Loan Mail Box PersonnelList", "Morning PersonnelList", _ + "Afternoon PersonnelList", "AOH PersonnelList", "Sat AOH PersonnelList") + tblNames = Array("LoanMailBoxMainList", "MorningMainList", "AfternoonMainList", _ + "AOHMainList", "SatAOHMainList") + + ' Ask for confirmation before clearing + If MsgBox("This action will clear the current roster table. Are you sure you want to proceed?", vbYesNo + vbQuestion, "Confirm Clear") = vbNo Then + Exit Sub ' Exit Main if user selects No End If + + wsRoster.Unprotect + + ' Clear table content + wsRoster.Range("D6:O189").ClearContents + wsRoster.Range("D6:O189").Rows.AutoFit + + + ' Loop through all specified sheets and unprotect the sheets + For i = 0 To UBound(sheetNames) + On Error Resume Next ' Enable error handling + Set ws = ThisWorkbook.Sheets(sheetNames(i)) + If Not ws Is Nothing Then + Debug.Print "Attempting to unprotect sheet: " & sheetNames(i) & " at " & Now + ws.Unprotect + If Err.Number = 0 Then + Debug.Print "Successfully unprotected sheet: " & sheetNames(i) & ws.ProtectContents + Else + Debug.Print "Failed to unprotect sheet: " & sheetNames(i) & " - Error: " & Err.Description + Err.Clear + End If + Else + Debug.Print "Sheet not found: " & sheetNames(i) + End If + On Error GoTo 0 ' Disable error handling + Next i ' Loop through each date row - For dateRow = START_ROW To LAST_ROW_ROSTER + For dateRow = START_ROW To last_row_roster currDate = wsRoster.Cells(dateRow, DATE_COL).Value ' Reset formatting for all slots For Each slotCol In Array(LMB_COL, MOR_COL, AFT_COL, AOH_COL, SAT_AOH_COL1, SAT_AOH_COL2) @@ -46,13 +92,13 @@ Attribute Main.VB_ProcData.VB_Invoke_Func = "M\n14" Next slotCol 'Check for Closed date - If IsClosedDay(currDate) Then + If IsClosedDate(currDate) Then Call MarkAllSlotsClosed(dateRow) End If Next dateRow - 'Call ResetAllCounters.ResetAllCounters + Call ResetAllCounters.ResetAllCounters Call AssignSatAOHDuties.AssignSatAOHDuties Call AssignAOHDuties.AssignAOHDuties @@ -61,14 +107,39 @@ Attribute Main.VB_ProcData.VB_Invoke_Func = "M\n14" Call AssignLoanMailBoxDuties.AssignLoanMailBoxDuties Call DuplicateSystemRoster.DuplicateSystemRoster + + ' Reprotect the worksheet and lock table ranges + For i = 0 To UBound(sheetNames) + Set ws = ThisWorkbook.Sheets(sheetNames(i)) + Set tbl = ws.ListObjects(tblNames(i)) + + + With ws + If Not tbl Is Nothing Then + .ListObjects(tbl.Name).Range.Locked = True + End If + .Range("D5:D9").Locked = False ' keep data entry remains unlocked + .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _ + AllowFiltering:=True, AllowSorting:=True, AllowUsingPivotTables:=True + End With + + Next i + + ' Reprotect the Roster sheet with specified properties + 'With wsRoster + ' .Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, _ + ' AllowFormattingCells:=True, AllowFormattingColumns:=True, _ + ' AllowFormattingRows:=True + 'End With + End Sub -Function IsClosedDate(currDate As Date) As Boolean +Private Function IsClosedDate(currDate As Date) As Boolean IsClosedDate = (Weekday(currDate, vbMonday) = 7) Or _ Application.WorksheetFunction.CountIf(wsSettings.Range("Settings_Holidays"), currDate) > 0 End Function -Sub MarkAllSlotsClosed(dateRow As Long) +Private Sub MarkAllSlotsClosed(dateRow As Long) Dim col As Variant For Each col In Array(LMB_COL, MOR_COL, AFT_COL, AOH_COL, SAT_AOH_COL1, SAT_AOH_COL2) With wsRoster.Cells(dateRow, col)