From 7bd1dcd45a067da0fdc9125fc2c1c4c72bb4ef01 Mon Sep 17 00:00:00 2001 From: Casielim Date: Fri, 18 Jul 2025 14:21:09 +0800 Subject: [PATCH 1/2] Assign Sat AOH staff --- .../AssignSatAOHDuties.bas | 97 +++++++++++++++++++ 1 file changed, 97 insertions(+) create mode 100644 VBA/VBA-Code_By_Modules/AssignSatAOHDuties.bas diff --git a/VBA/VBA-Code_By_Modules/AssignSatAOHDuties.bas b/VBA/VBA-Code_By_Modules/AssignSatAOHDuties.bas new file mode 100644 index 0000000..8c47e74 --- /dev/null +++ b/VBA/VBA-Code_By_Modules/AssignSatAOHDuties.bas @@ -0,0 +1,97 @@ +Attribute VB_Name = "AssignSatAOHDuties" +' Declare worksheet and table + Private wsRoster As Worksheet + Private wsPersonnel As Worksheet + Private wsSettings As Worksheet + Private aohtbl As ListObject + Private spectbl As ListObject + +Sub AssignSatAOHDuties() + Set wsRoster = Sheets("MasterCopy (2)") + Set wsSettings = Sheets("Settings") + Set wsPersonnel = Sheets("Sat AOH PersonnelList") + Set aohtbl = wsPersonnel.ListObjects("SatAOHMainList") + + Dim i As Long, r As Long + Dim maxDuties As Long + Dim staffName As String + Dim assignedStaff1 As String + + ' Pass 1: Assign staff to SAT_AOH_COL1 + For r = START_ROW To LAST_ROW_ROSTER + Dim dayValue As String + dayValue = Trim(wsRoster.Cells(r, DAY_COL).Text) + Debug.Print "Row " & r & " Day Value: '" & dayValue & "'" + If dayValue = "Sat" Then + Debug.Print "Processing row " & r & " (Saturday found)" + If wsRoster.Cells(r, SAT_AOH_COL1).Value = "" Then + For i = 1 To aohtbl.ListRows.Count + staffName = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Name").Index).Value + maxDuties = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Max Duties").Index).Value + Dim currDuties As Long + currDuties = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Duties Counter").Index).Value + Debug.Print " Checking staff " & staffName & " (Max Duties: " & maxDuties & ", Curr Duties: " & currDuties & ")" + If currDuties < maxDuties Then + wsRoster.Cells(r, SAT_AOH_COL1).Value = staffName + Call IncrementDutiesCounter(staffName) + assignedStaff1 = staffName + Debug.Print "Assigned All Days staff " & staffName & " to row " & r & " (SAT_AOH_COL1)" + Exit For + Else + Debug.Print " Skipped: Max duties reached or weekly limit exceeded" + End If + Next i + End If + End If + Next r + + ' Pass 2: Assign different staff to SAT_AOH_COL2 + For r = START_ROW To LAST_ROW_ROSTER + Dim dayValue2 As String + dayValue2 = Trim(wsRoster.Cells(r, DAY_COL).Text) + Debug.Print "Row " & r & " Day Value: '" & dayValue2 & "'" + If dayValue2 = "Sat" And wsRoster.Cells(r, SAT_AOH_COL1).Value <> "" And wsRoster.Cells(r, SAT_AOH_COL2).Value = "" Then + Debug.Print "Processing row " & r & " for SAT_AOH_COL2" + For i = 1 To aohtbl.ListRows.Count + staffName = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Name").Index).Value + maxDuties = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Max Duties").Index).Value + Dim currDuties2 As Long + currDuties2 = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Duties Counter").Index).Value + Debug.Print " Checking staff " & staffName & " (Max Duties: " & maxDuties & ", Curr Duties: " & currDuties2 & ")" + If currDuties2 < maxDuties And staffName <> wsRoster.Cells(r, SAT_AOH_COL1).Value Then + wsRoster.Cells(r, SAT_AOH_COL2).Value = staffName + Call IncrementDutiesCounter(staffName) + Debug.Print "Assigned All Days staff " & staffName & " to row " & r & " (SAT_AOH_COL2)" + Exit For + Else + Debug.Print " Skipped: Max duties reached, weekly limit exceeded, or same as SAT_AOH_COL1" + End If + Next i + End If + Next r + + MsgBox "Sat AOH duties assignment completed!", vbInformation +End Sub + +Sub IncrementDutiesCounter(staffName As String) + Dim rowIdx As Variant + Dim foundCell As Range + + ' Search for the staff name + Set foundCell = aohtbl.ListColumns("Name").DataBodyRange.Find( _ + What:=staffName, LookIn:=xlValues, LookAt:=xlWhole) + + If Not foundCell Is Nothing Then + ' Get relative row index in the table + rowIdx = foundCell.row - aohtbl.HeaderRowRange.row + + ' Increment Duties Counter + With aohtbl.ListRows(rowIdx).Range.Cells(aohtbl.ListColumns("Duties Counter").Index) + .Value = .Value + 1 + End With + Else + MsgBox "Staff '" & staffName & "' not found in table.", vbExclamation + End If +End Sub + + From ed610b0286f3b6575e0a2da94c0f986e7bc6cc84 Mon Sep 17 00:00:00 2001 From: Casielim Date: Thu, 31 Jul 2025 22:35:21 +0800 Subject: [PATCH 2/2] Set reassignment --- .../AssignSatAOHDuties.bas | 75 ++++++++++++------- 1 file changed, 49 insertions(+), 26 deletions(-) diff --git a/VBA/VBA-Code_By_Modules/AssignSatAOHDuties.bas b/VBA/VBA-Code_By_Modules/AssignSatAOHDuties.bas index 8c47e74..58929db 100644 --- a/VBA/VBA-Code_By_Modules/AssignSatAOHDuties.bas +++ b/VBA/VBA-Code_By_Modules/AssignSatAOHDuties.bas @@ -1,13 +1,13 @@ Attribute VB_Name = "AssignSatAOHDuties" ' Declare worksheet and table - Private wsRoster As Worksheet - Private wsPersonnel As Worksheet - Private wsSettings As Worksheet - Private aohtbl As ListObject - Private spectbl As ListObject +Private wsRoster As Worksheet +Private wsSettings As Worksheet +Private wsPersonnel As Worksheet +Private aohtbl As ListObject +Private spectbl As ListObject Sub AssignSatAOHDuties() - Set wsRoster = Sheets("MasterCopy (2)") + Set wsRoster = Sheets("Roster") Set wsSettings = Sheets("Settings") Set wsPersonnel = Sheets("Sat AOH PersonnelList") Set aohtbl = wsPersonnel.ListObjects("SatAOHMainList") @@ -16,57 +16,79 @@ Sub AssignSatAOHDuties() Dim maxDuties As Long Dim staffName As String Dim assignedStaff1 As String - + Dim prevSatRow As Long + Dim prevStaff1 As String + Dim prevStaff2 As String + ' Pass 1: Assign staff to SAT_AOH_COL1 - For r = START_ROW To LAST_ROW_ROSTER + For r = START_ROW To last_row_roster Dim dayValue As String dayValue = Trim(wsRoster.Cells(r, DAY_COL).Text) - Debug.Print "Row " & r & " Day Value: '" & dayValue & "'" If dayValue = "Sat" Then - Debug.Print "Processing row " & r & " (Saturday found)" If wsRoster.Cells(r, SAT_AOH_COL1).Value = "" Then - For i = 1 To aohtbl.ListRows.Count + prevSatRow = r - 7 ' Previous Saturday (exactly 7 days back) + Debug.Print "prevsatrow: " & prevSatRow + If prevSatRow >= START_ROW Then + If wsRoster.Cells(prevSatRow, DAY_COL).Text = "Sat" Then + prevStaff1 = wsRoster.Cells(prevSatRow, SAT_AOH_COL1).Value + prevStaff2 = wsRoster.Cells(prevSatRow, SAT_AOH_COL2).Value + End If + Else + prevStaff1 = "" ' No previous Saturday or unassigned + prevStaff2 = "" + End If + + For i = 1 To aohtbl.ListRows.count staffName = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Name").Index).Value maxDuties = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Max Duties").Index).Value Dim currDuties As Long currDuties = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Duties Counter").Index).Value - Debug.Print " Checking staff " & staffName & " (Max Duties: " & maxDuties & ", Curr Duties: " & currDuties & ")" - If currDuties < maxDuties Then + + If currDuties < maxDuties And (prevStaff1 = "" Or prevStaff2 = "" Or (staffName <> prevStaff1 And staffName <> prevStaff2)) Then wsRoster.Cells(r, SAT_AOH_COL1).Value = staffName Call IncrementDutiesCounter(staffName) assignedStaff1 = staffName - Debug.Print "Assigned All Days staff " & staffName & " to row " & r & " (SAT_AOH_COL1)" Exit For - Else - Debug.Print " Skipped: Max duties reached or weekly limit exceeded" End If Next i + If wsRoster.Cells(r, SAT_AOH_COL1).Value = "" Then + Debug.Print "Warning: No eligible staff for SAT_AOH_COL1 at row " & r & " due to consecutive SAT AOH constraint or insufficient staff." + End If End If End If Next r ' Pass 2: Assign different staff to SAT_AOH_COL2 - For r = START_ROW To LAST_ROW_ROSTER + For r = START_ROW To last_row_roster Dim dayValue2 As String dayValue2 = Trim(wsRoster.Cells(r, DAY_COL).Text) - Debug.Print "Row " & r & " Day Value: '" & dayValue2 & "'" If dayValue2 = "Sat" And wsRoster.Cells(r, SAT_AOH_COL1).Value <> "" And wsRoster.Cells(r, SAT_AOH_COL2).Value = "" Then - Debug.Print "Processing row " & r & " for SAT_AOH_COL2" - For i = 1 To aohtbl.ListRows.Count + prevSatRow = r - 7 ' Previous Saturday + If prevSatRow >= START_ROW Then + If wsRoster.Cells(prevSatRow, DAY_COL).Text = "Sat" Then + prevStaff1 = wsRoster.Cells(prevSatRow, SAT_AOH_COL1).Value + prevStaff2 = wsRoster.Cells(prevSatRow, SAT_AOH_COL2).Value + End If + Else + prevStaff1 = "" ' No previous Saturday or unassigned + prevStaff2 = "" + End If + + For i = 1 To aohtbl.ListRows.count staffName = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Name").Index).Value maxDuties = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Max Duties").Index).Value Dim currDuties2 As Long currDuties2 = aohtbl.DataBodyRange(i, aohtbl.ListColumns("Duties Counter").Index).Value - Debug.Print " Checking staff " & staffName & " (Max Duties: " & maxDuties & ", Curr Duties: " & currDuties2 & ")" - If currDuties2 < maxDuties And staffName <> wsRoster.Cells(r, SAT_AOH_COL1).Value Then + If currDuties2 < maxDuties And staffName <> wsRoster.Cells(r, SAT_AOH_COL1).Value And _ + (prevStaff1 = "" Or prevStaff2 = "" Or (staffName <> prevStaff1 And staffName <> prevStaff2)) Then wsRoster.Cells(r, SAT_AOH_COL2).Value = staffName Call IncrementDutiesCounter(staffName) - Debug.Print "Assigned All Days staff " & staffName & " to row " & r & " (SAT_AOH_COL2)" Exit For - Else - Debug.Print " Skipped: Max duties reached, weekly limit exceeded, or same as SAT_AOH_COL1" End If Next i + If wsRoster.Cells(r, SAT_AOH_COL2).Value = "" Then + Debug.Print "Warning: No eligible staff for SAT_AOH_COL2 at row " & r & " due to consecutive SAT AOH constraint or insufficient staff." + End If End If Next r @@ -84,7 +106,7 @@ Sub IncrementDutiesCounter(staffName As String) If Not foundCell Is Nothing Then ' Get relative row index in the table rowIdx = foundCell.row - aohtbl.HeaderRowRange.row - + Debug.Print "Checking worksheet status: " & wsPersonnel.ProtectContents ' Increment Duties Counter With aohtbl.ListRows(rowIdx).Range.Cells(aohtbl.ListColumns("Duties Counter").Index) .Value = .Value + 1 @@ -95,3 +117,4 @@ Sub IncrementDutiesCounter(staffName As String) End Sub +