diff --git a/VBA/VBA-Code_By_Modules/CountSlotsSub.bas b/VBA/VBA-Code_By_Modules/CountSlotsSub.bas new file mode 100644 index 0000000..28a584b --- /dev/null +++ b/VBA/VBA-Code_By_Modules/CountSlotsSub.bas @@ -0,0 +1,181 @@ +Attribute VB_Name = "CountSlotsSub" +Public Sub countMorningOrAfternoonOrLMBSlotsSub(Worksheet As String, ByRef result As Long) + Dim startDate As Date + Dim endDate As Date + Dim currentDate As Date + Dim r As Long + Dim holidayCell As Range + Dim isHoliday As Boolean + Dim ws As Worksheet + Dim last_row_roster As Long + + Set ws = ThisWorkbook.Sheets(Worksheet) + + ' Initialize counter + result = 0 + + ' Get the fixed start and end dates from H3 and K3 on the provided worksheet + startDate = ws.Range("H3").Value + endDate = ws.Range("K3").Value + If Not IsDate(startDate) Or Not IsDate(endDate) Then + Debug.Print "Invalid dates in H3 or K3: " & ws.Range("H3").Value & ", " & ws.Range("K3").Value + Exit Sub + End If + + ' Ensure startDate is before or equal to endDate + If startDate > endDate Then + Dim tempDate As Date + tempDate = startDate + startDate = endDate + endDate = tempDate + End If + + 'Find last row of roster + If ws.Cells(2, 10).Value = "Jan-Jun" And ws.Cells(2, 13).Value Mod 4 = 0 Then + last_row_roster = 187 + ElseIf ws.Cells(2, 10).Value = "Jan-Jun" Then + last_row_roster = 186 + Else + last_row_roster = 189 + End If + + ' Loop through each row in column B + For r = 6 To last_row_roster + currentDate = ws.Cells(r, 2).Value ' Date from column B + If IsDate(Trim(currentDate)) Then + ' Check if the date is within the custom period + If currentDate >= startDate And currentDate <= endDate Then + ' Check if it's not Sunday (1) or Saturday (7) + If Weekday(currentDate) <> 1 And Weekday(currentDate) <> 7 Then + ' Check if it's not a public holiday using the named range + isHoliday = False + For Each holidayCell In Range("Settings_Holidays") + If IsDate(holidayCell.Value) Then + If dateValue(currentDate) = dateValue(holidayCell.Value) Then + isHoliday = True + Exit For + End If + End If + Next holidayCell + ' If not a holiday, increment counter + If Not isHoliday Then + result = result + 1 + End If + End If + End If + End If + Next r +End Sub +Public Sub countAOHslotsSub(Worksheet As String, ByRef result As Long) + Dim startDate As Date + Dim endDate As Date + Dim currentDate As Date + Dim r As Long + Dim holidayCell As Range + Dim isHoliday As Boolean + Dim ws As Worksheet + Dim last_row_roster As Long + + ' Initialize counter + result = 0 + + ' Set worksheet reference + Set ws = ThisWorkbook.Sheets(Worksheet) + + ' Get the fixed start and end dates from H3 and K3 + startDate = ws.Range("H3").Value + endDate = ws.Range("K3").Value + If Not IsDate(startDate) Or Not IsDate(endDate) Then Exit Sub ' Exit if dates are invalid + + ' Ensure startDate is before or equal to endDate + If startDate > endDate Then + Dim tempDate As Date + tempDate = startDate + startDate = endDate + endDate = tempDate + End If + + ' Find last row of roster + If ws.Cells(2, 10).Value = "Jan-Jun" And ws.Cells(2, 13).Value Mod 4 = 0 Then + last_row_roster = 187 + ElseIf ws.Cells(2, 10).Value = "Jan-Jun" Then + last_row_roster = 186 + Else + last_row_roster = 189 + End If + + ' Loop through each row in column B + For r = 6 To last_row_roster + currentDate = ws.Cells(r, 2).Value ' Date from column B + If IsDate(Trim(currentDate)) Then + ' Check if the date is within the custom period + If currentDate >= startDate And currentDate <= endDate Then + ' Check if it's not Sunday (1) or Saturday (7) + If Weekday(currentDate) <> 1 And Weekday(currentDate) <> 7 Then + ' Check if it's not a public holiday using the named range + isHoliday = False + For Each holidayCell In Range("Settings_Holidays") + If IsDate(holidayCell.Value) Then + If dateValue(currentDate) = dateValue(holidayCell.Value) Then + isHoliday = True + Exit For + End If + End If + Next holidayCell + ' Check if the corresponding marker in column A is "sem time" + If Not isHoliday And LCase(Trim(ws.Cells(r, 1).Value)) = "sem time" Then + result = result + 1 + End If + End If + End If + End If + Next r +End Sub +Public Sub countSatAOHSub(Worksheet As String, ByRef result As Long) + Dim startDate As Date + Dim endDate As Date + Dim currentDate As Date + Dim ws As Worksheet + Dim holidayCell As Range + Dim holidaySaturdays As Long + + ' Initialize counter + result = 0 + + ' Set worksheet reference + Set ws = ThisWorkbook.Sheets(Worksheet) + + ' Get the start and end dates from H3 and K3 + startDate = ws.Range("H3").Value + endDate = ws.Range("K3").Value + If Not IsDate(startDate) Or Not IsDate(endDate) Then Exit Sub ' Exit if dates are invalid + + ' Ensure startDate is before or equal to endDate + If startDate > endDate Then + Dim tempDate As Date + tempDate = startDate + startDate = endDate + endDate = tempDate + End If + + ' Count Saturdays in the date range + currentDate = startDate + Do While currentDate <= endDate + If Weekday(currentDate) = 7 Then ' 7 = Saturday + result = result + 1 + End If + currentDate = currentDate + 1 + Loop + + ' Subtract Saturdays that are public holidays + holidaySaturdays = 0 + For Each holidayCell In Range("Settings_Holidays") + If IsDate(holidayCell.Value) Then + If dateValue(holidayCell.Value) >= startDate And dateValue(holidayCell.Value) <= endDate And Weekday(holidayCell.Value) = 7 Then + holidaySaturdays = holidaySaturdays + 1 + End If + End If + Next holidayCell + result = result - holidaySaturdays +End Sub + diff --git a/VBA/VBA-Code_By_Modules/HidePersonnelSheets.bas b/VBA/VBA-Code_By_Modules/HidePersonnelSheets.bas new file mode 100644 index 0000000..2adb6dc --- /dev/null +++ b/VBA/VBA-Code_By_Modules/HidePersonnelSheets.bas @@ -0,0 +1,27 @@ +Attribute VB_Name = "HidePersonnelSheets" +Sub HidePersonnelSheetsWithPassword() + Dim ws As Worksheet + Dim enteredPassword As String + Const password As String = "rostering2025" + + enteredPassword = InputBox("Please enter the password hide all Personnel List sheets:", "Password Authentication") + If enteredPassword <> password Then + MsgBox "Incorrect password. Hiding operation declined.", vbCritical + Exit Sub + End If + + ' Loop through all worksheets and hide personnel lists + For Each ws In ThisWorkbook.Sheets + Select Case UCase(ws.Name) + Case UCase("AOH PersonnelList"), UCase("Sat AOH PersonnelList"), _ + UCase("Loan Mail Box PersonnelList"), UCase("Morning PersonnelList"), _ + UCase("Afternoon PersonnelList") + ' Protect the entire sheet + ws.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True + ' Set to "Very Hidden" (not visible in UI, only via VBA) + ws.Visible = xlSheetVeryHidden + End Select + Next ws + + MsgBox "Personnel list sheets have been hidden.", vbInformation +End Sub diff --git a/VBA/VBA-Code_By_Modules/ResetAllCounters.bas b/VBA/VBA-Code_By_Modules/ResetAllCounters.bas new file mode 100644 index 0000000..9d18e71 --- /dev/null +++ b/VBA/VBA-Code_By_Modules/ResetAllCounters.bas @@ -0,0 +1,47 @@ +Attribute VB_Name = "ResetAllCounters" +Sub ResetAllCounters() + Dim ws As Worksheet + Dim tbl As ListObject + Dim counterColumn As ListColumn + Dim tblNames As Variant + Dim sheetNames As Variant + Dim i As Integer + Dim wsRoster As Worksheet + + ' 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") + + ' Loop through all specified tables and reset Duties Counter column to 0 + For i = 0 To UBound(sheetNames) + Set ws = ThisWorkbook.Sheets(sheetNames(i)) + ws.Unprotect + Set tbl = ws.ListObjects(tblNames(i)) + + Set counterColumn = tbl.ListColumns("Duties Counter") + + Dim j As Long + For j = 1 To counterColumn.DataBodyRange.Rows.Count + counterColumn.DataBodyRange.Cells(j, 1).Value = 0 + Next j + + ' Reprotect the worksheet and lock table ranges + 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 + + ' Activate Roster sheet + Set wsRoster = Sheets("Roster") + wsRoster.Activate +End Sub + +