Insert staff

VBA/VBA-Code_By_Modules/DeleteStaff.bas

@@ -0,0 +1,144 @@
+Attribute VB_Name = "DeleteStaff"
+Sub DeleteStaff()
+    On Error GoTo ErrHandler
+
+    Dim ws As Worksheet
+    Dim tbl As ListObject
+    Dim selectedCell As Range
+    Dim rowToDelete As ListRow
+    Dim dutyType As String
+    Dim password As String
+    Dim specificDaysTbl As ListObject
+    Dim availIndex As Long
+
+    ' Protection password
+    password = "nuslib2025"
+
+    ' Authorization check
+    Dim userPassword As String
+    userPassword = InputBox("Enter the password to remove the staff:", "Authorization Required")
+    If userPassword <> password Then
+        MsgBox "Unauthorized access.", vbExclamation
+        Exit Sub
+    End If
+
+    ' Duty type based on the active sheet
+    Select Case UCase(ActiveSheet.Name)
+        Case UCase("Loan Mail Box PersonnelList")
+            dutyType = "LOANMAILBOX"
+            Set ws = ThisWorkbook.Sheets("Loan Mail Box PersonnelList")
+            Set tbl = ws.ListObjects("LoanMailBoxMainList")
+            Set specificDaysTbl = ws.ListObjects("LoanMailBoxSpecificDaysWorkingStaff")
+        Case UCase("Morning PersonnelList")
+            dutyType = "MORNING"
+            Set ws = ThisWorkbook.Sheets("Morning PersonnelList")
+            Set tbl = ws.ListObjects("MorningMainList")
+            Set specificDaysTbl = ws.ListObjects("MorningSpecificDaysWorkingStaff")
+        Case UCase("Afternoon PersonnelList")
+            dutyType = "AFTERNOON"
+            Set ws = ThisWorkbook.Sheets("Afternoon PersonnelList")
+            Set tbl = ws.ListObjects("AfternoonMainList")
+            Set specificDaysTbl = ws.ListObjects("AfternoonSpecificDaysWorkingStaff")
+        Case UCase("AOH PersonnelList")
+            dutyType = "AOH"
+            Set ws = ThisWorkbook.Sheets("AOH PersonnelList")
+            Set tbl = ws.ListObjects("AOHMainList")
+            Set specificDaysTbl = ws.ListObjects("AOHSpecificDaysWorkingStaff")
+        Case UCase("Sat AOH PersonnelList")
+            dutyType = "SAT_AOH"
+            Set ws = ThisWorkbook.Sheets("Sat AOH PersonnelList")
+            Set tbl = ws.ListObjects("SatAOHMainList")
+            ' No specificDaysTbl for Sat AOH
+        Case Else
+            MsgBox "This sheet is not a personnel list. Please select a valid personnel list sheet.", vbExclamation
+            Exit Sub
+    End Select
+
+    ' Validate worksheet and table
+    If ws Is Nothing Then
+        MsgBox "Worksheet for " & dutyType & " not found.", vbExclamation
+        Exit Sub
+    End If
+    If tbl Is Nothing Then
+        MsgBox "Table 'MainList' not found on '" & ws.Name & "'.", vbExclamation
+        Exit Sub
+    End If
+
+    ' Get the selected cell
+    Set selectedCell = ActiveCell
+    If Not Intersect(selectedCell, tbl.Range) Is Nothing Then
+        ' Check if the selected cell is in the "Name" column
+        Dim nameIndex As Long
+        nameIndex = GetColumnIndex(tbl, "Name")
+        If nameIndex = -1 Then
+            MsgBox "Column 'Name' not found in '" & tbl.Name & "'.", vbExclamation
+            GoTo ReprotectAndExit
+        End If
+        If selectedCell.Column = tbl.Range.Cells(1, nameIndex).Column Then
+            ' Find the row in the table
+            Dim rowIndex As Long
+            rowIndex = selectedCell.row - tbl.Range.row
+            If rowIndex >= 1 And rowIndex <= tbl.ListRows.Count Then
+                Set rowToDelete = tbl.ListRows(rowIndex)
+                ' Get the Availability Type index
+                availIndex = GetColumnIndex(tbl, "Availability Type")
+                If availIndex = -1 Then
+                    MsgBox "Column 'Availability Type' not found in '" & tbl.Name & "'.", vbExclamation
+                    GoTo ReprotectAndExit
+                End If
+                ' Check if the staff is a Specific Days worker
+                If UCase(Trim(rowToDelete.Range.Cells(1, availIndex).Value)) = "SPECIFIC DAYS" And Not specificDaysTbl Is Nothing Then
+                    Dim sdRow As ListRow
+                    Dim sdNameIndex As Long
+                    sdNameIndex = GetColumnIndex(specificDaysTbl, "Name")
+                    If sdNameIndex = -1 Then
+                        MsgBox "Column 'Name' not found in '" & specificDaysTbl.Name & "'.", vbExclamation
+                        GoTo ReprotectAndExit
+                    End If
+                    ' Find and delete the corresponding row in SpecificDaysWorkingStaff
+                    For Each sdRow In specificDaysTbl.ListRows
+                        If UCase(Trim(sdRow.Range.Cells(1, sdNameIndex).Value)) = UCase(Trim(selectedCell.Value)) Then
+                            sdRow.Delete
+                            Exit For
+                        End If
+                    Next sdRow
+                End If
+                rowToDelete.Delete
+                CalculateMaxDuties.CalculateMaxDuties dutyType
+                MsgBox "Staff deleted and Max Duties recalculated successfully for " & dutyType & ".", vbInformation
+            Else
+                MsgBox "Selected cell is not within a valid table row.", vbExclamation
+                GoTo ReprotectAndExit
+            End If
+        Else
+            MsgBox "Please select a cell in the 'Name' column to delete the staff.", vbExclamation
+            GoTo ReprotectAndExit
+        End If
+    Else
+        MsgBox "Please select a cell within the table to delete a staff.", vbExclamation
+        GoTo ReprotectAndExit
+    End If
+    Exit Sub
+
+ReprotectAndExit:
+    ' Reprotect the worksheet
+    ws.Protect password, DrawingObjects:=True, Contents:=True, Scenarios:=True
+    Exit Sub
+
+ErrHandler:
+    MsgBox "An error occurred: " & Err.Description & vbCrLf & _
+           "Line: " & Erl & vbCrLf & _
+           "Duty Type: " & dutyType & vbCrLf & _
+           "Worksheet: " & IIf(ws Is Nothing, "Not Set", ws.Name), vbCritical
+    ws.Protect password, DrawingObjects:=True, Contents:=True, Scenarios:=True ' Reprotect on error
+    Exit Sub
+End Sub
+
+' Helper function to get column index
+Private Function GetColumnIndex(tbl As ListObject, columnName As String) As Long
+    On Error Resume Next
+    GetColumnIndex = tbl.ListColumns(columnName).Index
+    If Err.Number <> 0 Then GetColumnIndex = -1
+    On Error GoTo 0
+End Function
+

VBA/VBA-Code_By_Modules/Insert Staff.bas

@@ -0,0 +1,200 @@
+Attribute VB_Name = "InsertStaff"
+Sub InsertStaff(dutyType As String)
+    On Error GoTo ErrHandler
+
+    Dim ws As Worksheet
+    Dim tbl As ListObject
+    Dim newRow As ListRow
+    Dim staffName As String, dept As String
+    Dim availType As String, workDays As String, percentage As String
+    Dim checkRow As Long
+    Dim specificDaysTbl As ListObject
+    Dim specificRow As ListRow
+
+    ' Set worksheet and tables based on dutyType
+    Select Case UCase(dutyType)
+        Case "LOANMAILBOX"
+            Set ws = ThisWorkbook.Sheets("Loan Mail Box PersonnelList")
+            Set tbl = ws.ListObjects("LoanMailBoxMainList")
+            Set specificDaysTbl = ws.ListObjects("LoanMailBoxSpecificDaysWorkingStaff")
+        Case "MORNING"
+            Set ws = ThisWorkbook.Sheets("Morning PersonnelList")
+            Set tbl = ws.ListObjects("MorningMainList")
+            Set specificDaysTbl = ws.ListObjects("MorningSpecificDaysWorkingStaff")
+        Case "AFTERNOON"
+            Set ws = ThisWorkbook.Sheets("Afternoon PersonnelList")
+            Set tbl = ws.ListObjects("AfternoonMainList")
+            Set specificDaysTbl = ws.ListObjects("AfternoonSpecificDaysWorkingStaff")
+        Case "AOH"
+            Set ws = ThisWorkbook.Sheets("AOH PersonnelList")
+            Set tbl = ws.ListObjects("AOHMainList")
+            Set specificDaysTbl = ws.ListObjects("AOHSpecificDaysWorkingStaff")
+        Case "SAT_AOH"
+            Set ws = ThisWorkbook.Sheets("Sat AOH PersonnelList")
+            Set tbl = ws.ListObjects("SatAOHMainList")
+            ' No specificDaysTbl for Sat AOH
+        Case Else
+            MsgBox "Invalid duty type. Use 'LoanMailBox', 'Morning', 'Afternoon', 'AOH', or 'Sat_AOH'.", vbExclamation
+            Exit Sub
+    End Select
+
+    ' Validate worksheet and table
+    If ws Is Nothing Then
+        MsgBox "Worksheet for " & dutyType & " not found.", vbExclamation
+        Exit Sub
+    End If
+    If tbl Is Nothing Then
+        MsgBox "Table 'MainList' not found on '" & ws.Name & "'.", vbExclamation
+        Exit Sub
+    End If
+    If specificDaysTbl Is Nothing And UCase(Trim(ws.Range("D7").Value)) = "SPECIFIC DAYS" And UCase(dutyType) <> "SAT_AOH" Then
+        MsgBox "Table 'SpecificDaysWorkingStaff' not found on '" & ws.Name & "'.", vbExclamation
+        Exit Sub
+    End If
+
+    ' Unprotect the worksheet (unlock)
+    ws.Unprotect
+
+    ' Read input values from the unlocked data entry range
+    staffName = UCase(Trim(ws.Range("D5").Value)) ' Name
+    dept = Trim(ws.Range("D6").Value)             ' Department
+    availType = UCase(Trim(ws.Range("D7").Value)) ' Availability Type
+    workDays = Trim(ws.Range("D8").Value)         ' Working Days
+    percentage = Trim(ws.Range("D9").Value)       ' Duties Percentage
+
+    ' Auto-fill logic based on Availability Type
+    If availType = "ALL DAYS" Then
+        percentage = "100"
+        workDays = ""
+    ElseIf availType = "SPECIFIC DAYS" Then
+        If workDays = "" Then
+            MsgBox "Please enter Working Days for Specific Days availability.", vbExclamation
+            GoTo ReprotectAndExit
+        End If
+    End If
+
+    ' Validate percentage
+    If percentage = "" Or Not IsNumeric(percentage) Or Val(percentage) <= 0 Or Val(percentage) > 100 Then
+        MsgBox "Please enter a valid Duties Percentage (1-100).", vbExclamation
+        GoTo ReprotectAndExit
+    End If
+
+    If Len(Trim(staffName)) = 0 Or Len(Trim(dept)) = 0 Then
+        MsgBox "Please fill in Name and Department.", vbExclamation
+        GoTo ReprotectAndExit
+    End If
+
+    ' Check for duplicate names
+    For checkRow = 1 To tbl.ListRows.Count
+        If UCase(Trim(tbl.ListRows(checkRow).Range.Cells(1, GetColumnIndex(tbl, "Name")).Value)) = staffName Then
+            MsgBox "This staff name already exists.", vbExclamation
+            GoTo ReprotectAndExit
+        End If
+    Next checkRow
+
+    Set newRow = tbl.ListRows.Add(AlwaysInsert:=True)
+    With newRow.Range
+        Dim nameIndex As Long, deptIndex As Long, availIndex As Long
+        Dim percIndex As Long, maxIndex As Long, counterIndex As Long
+
+        nameIndex = GetColumnIndex(tbl, "Name")
+        deptIndex = GetColumnIndex(tbl, "Department")
+        availIndex = GetColumnIndex(tbl, "Availability Type")
+        percIndex = GetColumnIndex(tbl, "Duties Percentage (%)")
+        maxIndex = GetColumnIndex(tbl, "Max Duties")
+        counterIndex = GetColumnIndex(tbl, "Duties Counter")
+
+        If nameIndex = -1 Or deptIndex = -1 Or counterIndex = -1 Or availIndex = -1 Or percIndex = -1 Or maxIndex = -1 Then
+            MsgBox "Required columns 'Name', 'Department', 'Availability Type', 'Duties Percentage', 'Max Duties', or 'Duties Counter' not found in '" & tbl.Name & "'.", vbExclamation
+            newRow.Delete
+            GoTo ReprotectAndExit
+        End If
+
+        .Cells(1, nameIndex).Value = staffName
+        .Cells(1, deptIndex).Value = dept
+        .Cells(1, availIndex).Value = availType
+        .Cells(1, percIndex).Value = Val(percentage)
+        .Cells(1, counterIndex).Value = 0
+        ' Max Duties will be calculated later
+    End With
+
+    ' Handle specific days workers table
+    If availType = "SPECIFIC DAYS" Then
+        Set specificRow = specificDaysTbl.ListRows.Add(AlwaysInsert:=True)
+        With specificRow.Range
+            Dim specNameIndex As Long, specDaysIndex As Long
+            specNameIndex = GetColumnIndex(specificDaysTbl, "Name")
+            specDaysIndex = GetColumnIndex(specificDaysTbl, "Working Days")
+            If specNameIndex = -1 Or specDaysIndex = -1 Then
+                MsgBox "Columns 'Name' or 'Working Days' not found in '" & specificDaysTbl.Name & "'.", vbExclamation
+                specificRow.Delete
+                newRow.Delete
+                GoTo ReprotectAndExit
+            End If
+            .Cells(1, specNameIndex).Value = staffName
+            .Cells(1, specDaysIndex).Value = workDays
+        End With
+    End If
+
+    CalculateMaxDuties.CalculateMaxDuties dutyType
+
+    ' Clear input of data entry
+    ws.Range("D5:D9").ClearContents
+
+    MsgBox "Staff added and Max Duties calculated successfully for " & dutyType & "!", vbInformation
+    GoTo ReprotectAndExit
+
+ReprotectAndExit:
+    ' Reprotect the worksheet and lock table ranges
+    With ws
+        If Not tbl Is Nothing Then
+            .ListObjects(tbl.Name).Range.Locked = True
+        End If
+        If Not specificDaysTbl Is Nothing Then
+            .ListObjects(specificDaysTbl.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
+    Exit Sub
+
+ErrHandler:
+    MsgBox "An error occurred: " & Err.Description & vbCrLf & _
+           "Line: " & Erl & vbCrLf & _
+           "Duty Type: " & dutyType & vbCrLf & _
+           "Worksheet: " & IIf(ws Is Nothing, "Not Set", ws.Name), vbCritical
+    If Not newRow Is Nothing Then newRow.Delete
+    If Not specificRow Is Nothing Then specificRow.Delete
+    GoTo ReprotectAndExit
+End Sub
+
+' Helper function to get column index
+Private Function GetColumnIndex(tbl As ListObject, columnName As String) As Long
+    On Error Resume Next
+    GetColumnIndex = tbl.ListColumns(columnName).Index
+    If Err.Number <> 0 Then GetColumnIndex = -1
+    On Error GoTo 0
+End Function
+
+' Wrapper subroutines for different shifts
+Sub RunInsertStaffLMB()
+    InsertStaff "LoanMailBox"
+End Sub
+
+Sub RunInsertStaffMorning()
+    InsertStaff "Morning"
+End Sub
+
+Sub RunInsertStaffAfternoon()
+    InsertStaff "Afternoon"
+End Sub
+
+Sub RunInsertStaffAOH()
+    InsertStaff "AOH"
+End Sub
+
+Sub RunInsertStaffSatAOH()
+    InsertStaff "Sat_AOH"
+End Sub
+