Skip to content

Update all the modules #11

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
Casielim wants to merge 1 commit into
base: main
Choose a base branch
from
Open

Update all the modules #11

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
274 changes: 248 additions & 26 deletions VBA/VBA-Code_By_Modules/AssignEmployeeCopy.bas
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,34 @@
Attribute VB_Name = "AssignEmployeeCopy"
'declare worksheet and table
Private wsRosterCopy As Worksheet
Private wsPersonnel As Worksheet
Private wsSettings As Worksheet
Private morningtbl As ListObject

'declare roster column number
Private dateCol As Long
Private dayCol As Long
Private LMBCol As Long
Private morCol As Long
Private aftCol As Long
Private AOHCol As Long
Private satAOHCol1 As Long
Private satAOHCol2 As Long

Sub AssignFirstEmployeeToFirstSlotCopy()
Dim wsRosterCopy As Worksheet
Dim wsPersonnel As Worksheet
Set wsRosterCopy = Sheets("MasterCopy")
Set wsPersonnel = Sheets("PersonnelList (AOH & Desk)")
Set wsSettings = Sheets("Settings")

dateCol = 2
dayCol = 3
LMBCol = 4
morCol = 6
aftCol = 8
AOHCol = 10
satAOHCol1 = 12
satAOHCol2 = 14

Dim slotCols As Variant
Dim slotCol As Variant
Dim slotCell As Range
Expand All @@ -22,10 +49,7 @@ Sub AssignFirstEmployeeToFirstSlotCopy()
Dim isVacation As Boolean
Dim lastRowRoster As Integer

Set wsRosterCopy = Sheets("MasterCopy")
Set wsPersonnel = Sheets("PersonnelList (AOH & Desk)")
Set wsSettings = Sheets("Settings")


' Find last row number of the employee list
lastRow = wsPersonnel.Cells(wsPersonnel.Rows.Count, "B").End(xlUp).Row
found = False
Expand All @@ -42,33 +66,33 @@ Sub AssignFirstEmployeeToFirstSlotCopy()
'Loop through each date row
For dateRow = 6 To lastRowRoster

currDate = wsRosterCopy.Cells(dateRow, 2).Value
currDate = wsRosterCopy.Cells(dateRow, dateCol).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, 4).Value = "CLOSED" ' D column
wsRosterCopy.Cells(dateRow, 4).Interior.Color = vbRed
wsRosterCopy.Cells(dateRow, LMBCol).Value = "CLOSED" ' D column
wsRosterCopy.Cells(dateRow, LMBCol).Interior.Color = vbRed

wsRosterCopy.Cells(dateRow, 6).Value = "CLOSED" ' F column
wsRosterCopy.Cells(dateRow, 6).Interior.Color = vbRed
wsRosterCopy.Cells(dateRow, morCol).Value = "CLOSED" ' F column
wsRosterCopy.Cells(dateRow, morCol).Interior.Color = vbRed

wsRosterCopy.Cells(dateRow, 8).Value = "CLOSED" ' H column
wsRosterCopy.Cells(dateRow, 8).Interior.Color = vbRed
wsRosterCopy.Cells(dateRow, aftCol).Value = "CLOSED" ' H column
wsRosterCopy.Cells(dateRow, aftCol).Interior.Color = vbRed

wsRosterCopy.Cells(dateRow, 10).Value = "CLOSED" ' J column
wsRosterCopy.Cells(dateRow, 10).Interior.Color = vbRed
wsRosterCopy.Cells(dateRow, AOHCol).Value = "CLOSED" ' J column
wsRosterCopy.Cells(dateRow, AOHCol).Interior.Color = vbRed

wsRosterCopy.Cells(dateRow, 12).Value = "CLOSED" ' L column
wsRosterCopy.Cells(dateRow, 12).Interior.Color = vbRed
wsRosterCopy.Cells(dateRow, satAOHCol1).Value = "CLOSED" ' L column
wsRosterCopy.Cells(dateRow, satAOHCol1).Interior.Color = vbRed

wsRosterCopy.Cells(dateRow, 14).Value = "CLOSED" ' N column
wsRosterCopy.Cells(dateRow, 14).Interior.Color = vbRed
wsRosterCopy.Cells(dateRow, satAOHCol2).Value = "CLOSED" ' N column
wsRosterCopy.Cells(dateRow, satAOHCol2).Interior.Color = vbRed
GoTo NextDate ' Skip to the next date
End If

For Each slotCol In Array(4, 6, 8, 10, 12, 14) ' D, F, H, J, L, N columns
For Each slotCol In Array(LMBCol, morCol, aftCol, AOHCol, satAOHCol1, satAOHCol2) ' D, F, H, J, L, N columns
Set slotCell = wsRosterCopy.Cells(dateRow, slotCol)
slotCell.Interior.ColorIndex = xlNone ' Reset to no fill (default)
slotCell.Font.Strikethrough = False
Expand All @@ -79,7 +103,7 @@ Sub AssignFirstEmployeeToFirstSlotCopy()
isVacation = (wsRosterCopy.Cells(dateRow, 1).Value = "Vacation")

If isSaturday Then
slotCols = Array(12, 14) ' L, N for Saturday
slotCols = Array(satAOHCol1, satAOHCol2) ' L, N for Saturday
ElseIf isVacation Then
slotCols = Array(6, 8) ' F, H only for vacation weekdays (no J AOH)
Else
Expand All @@ -93,7 +117,7 @@ Sub AssignFirstEmployeeToFirstSlotCopy()
For Each slotCol In slotCols
Set slotCell = wsRosterCopy.Cells(dateRow, slotCol)
isAohSlot = (slotCol = 10 Or isSaturday) And Not isVacation ' J, L, or N as AOH
found = False
found = Falsez

'Loop through each staff
For currRow = 12 To lastRow
Expand Down Expand Up @@ -156,8 +180,206 @@ NextDate:

End Sub

Function countMorningOrAfternoonSlotsUDF() As Long
Application.Volatile
Dim startDate As Date
Dim endDate As Date
Dim currentDate As Date
Dim r As Long
Dim lastRow As Long
Dim holidayCell As Range
Dim isHoliday As Boolean
Dim ws As Worksheet

' Initialize counter
countMorningOrAfternoonSlotsUDF = 0

' Set worksheet reference
Set ws = ThisWorkbook.Sheets("MasterCopy")

' 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 Function ' 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

' Determine the last row with a valid date in column B
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
Do While lastRow >= 6
If IsDate(Trim(ws.Cells(lastRow, 2).Value)) Then
Exit Do
Else
lastRow = lastRow - 1
End If
Loop
If lastRow < 6 Then Exit Function ' No valid dates found

' Loop through each row in column B
For r = 6 To lastRow
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
countMorningOrAfternoonSlotsUDF = countMorningOrAfternoonSlotsUDF + 1
End If
End If
End If
End If
Next r
End Function
Function countAOHslotsUDF() As Long
Dim startDate As Date
Dim endDate As Date
Dim currentDate As Date
Dim r As Long
Dim lastRow As Long
Dim holidayCell As Range
Dim isHoliday As Boolean
Dim ws As Worksheet

' Initialize counter
countAOHslotsUDF = 0

' Set worksheet reference
Set ws = ThisWorkbook.Sheets("MasterCopy")

' 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 Function ' 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

' Determine the last row with a valid date in column B
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
Do While lastRow >= 6
If IsDate(Trim(ws.Cells(lastRow, 2).Value)) Then
Exit Do
Else
lastRow = lastRow - 1
End If
Loop
If lastRow < 6 Then Exit Function ' No valid dates found

' Loop through each row in column B
For r = 6 To lastRow
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
countAOHslotsUDF = countAOHslotsUDF + 1
End If
End If
End If
End If
Next r
End Function





Function countSatAOH() As Long
Dim startDate As Date
Dim endDate As Date
Dim currentDate As Date
Dim r As Long
Dim lastRow As Long
Dim holidayCell As Range
Dim isHoliday As Boolean
Dim ws As Worksheet

' Initialize counter
countSatAOH = 0

' Set worksheet reference
Set ws = ThisWorkbook.Sheets("MasterCopy")

' 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 Function ' 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

' Determine the last row with a valid date in column B
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
Do While lastRow >= 6
If IsDate(Trim(ws.Cells(lastRow, 2).Value)) Then
Exit Do
Else
lastRow = lastRow - 1
End If
Loop
If lastRow < 6 Then Exit Function ' No valid dates found

' Loop through each row in column B
For r = 6 To lastRow
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 a Saturday (7)
If 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
countSatAOH = countSatAOH + 1
End If
End If
End If
End If
Next r
End Function
64 changes: 64 additions & 0 deletions VBA/VBA-Code_By_Modules/CalculateMaxDuties.bas
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,64 @@
Attribute VB_Name = "CalculateMaxDuties"
Sub CalculateMaxDuties()
Dim ws As Worksheet
Dim morningtbl As ListObject
Set ws = ThisWorkbook.Sheets("PersonnelList Copy")
Set morningtbl = ws.ListObjects("MorningMainList")

Dim totalDuties As Long
Dim totalStaff As Long
Dim fullDuties As Long
Dim i As Long
Dim remaining As Long
Dim totalAssigned As Long
Dim dutiesPercentage As Double
Dim eligibleCount As Long
Dim eligible100() As Long 'Store the indices of staff with 100% duty
Dim j As Long
Dim rounded() As Long

totalStaff = morningtbl.ListRows.Count
totalDuties = ws.Range("H6").Value
fullDuties = WorksheetFunction.RoundDown(totalDuties / totalStaff, 0)
remaining = 0
eligibleCount = 0

ReDim eligible100(1 To totalStaff)
ReDim rounded(1 To totalStaff)

'Calculate initial duties and max cap
For i = 1 To totalStaff
dutiesPercentage = morningtbl.ListRows(i).Range.Cells(morningtbl.ListColumns("Duties Percentage (%)").Index).Value

If dutiesPercentage < 100 Then
rounded(i) = CLng(fullDuties * (dutiesPercentage / 100))
Else
rounded(i) = fullDuties
'Mark eligible 100% staff for distribution
eligibleCount = eligibleCount + 1
eligible100(eligibleCount) = i
End If

totalAssigned = totalAssigned + rounded(i)
Next i

'Distribute remaining slots to 100% staff
remaining = totalDuties - totalAssigned

If remaining > 0 Then
If eligibleCount > 0 Then
For j = 1 To remaining
i = eligible100(((j - 1) Mod eligibleCount) + 1) 'rotate among 100% staff
rounded(i) = rounded(i) + 1
Next j
Else
MsgBox "No available staff to assign remaining duties"
End If
End If

'Write results back to sheet
For i = 1 To totalStaff
morningtbl.ListRows(i).Range.Cells(morningtbl.ListColumns("Max Duties").Index).Value = rounded(i)
Next i

End Sub
Loading