Commons

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
+

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

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
+
+