Last active
March 1, 2021 16:29
-
-
Save shiva-karthick/b2f4eed10fc57e4cfec252f0d84c303c to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Public log As Logger | |
| Option Explicit ' Used at the module level to force explicit declaration of all variables in that module | |
| ' ================================== Variables for initVars sub ================================== | |
| Dim dutySlotsSheet As String | |
| Dim dutySlotsStartRow As Integer | |
| Dim dateCol As Integer | |
| Dim dayCol As Integer | |
| Dim firstActualCol As Integer | |
| Dim firstStbCol As Integer | |
| Dim numDutyCols As Integer | |
| Dim pointsCol As Integer | |
| Dim firstCheckCol As Integer | |
| Dim lastCheckCol As Integer | |
| Dim dutyTypeCell As String | |
| Dim monthCell As String | |
| Dim dutyHeaderRow As Integer | |
| Dim dutyType As String | |
| Dim planningmonth As Date | |
| ' ================================== end initVars Sub ================================== | |
| Dim slotPoints(2) As Integer ' slotPoints(numberOfPoints) = number of slots with that number of points | |
| Dim slotPoint As Integer | |
| Dim personnel(255) As DutyPersonnel ' Original : Dim personnel(255) as DutyPersonnel | |
| Dim numPersonnel As Integer | |
| ' Active slots | |
| Dim slots(255) As DutySlot ' Original : Dim slots(255) As DutySlot | |
| Dim numSlots As Integer | |
| ' Standby slots | |
| Dim standbySlots(255) As DutySlot ' Original : Dim slots(255) As DutySlot | |
| Dim numStandbySlots As Integer | |
| ' ================= Variables for Guard Duty planner sheet defined in initVars sub ================= | |
| Dim plannerSheet As String | |
| Dim dutyGapCell As String | |
| Dim standbyGapCell As String | |
| Dim minDutyGap As Integer | |
| Dim minStbGap As Integer | |
| ' =================================================== end =========================================== | |
| ' ================= Automate planning of duties ================= | |
| Sub PlanDuties() | |
| initVars ' Initialise variables | |
| Dim numRows As Integer | |
| Dim currentRow As Integer | |
| Dim totalPoints As Integer | |
| totalPoints = 0 | |
| Dim numDuties As Integer | |
| numDuties = 0 | |
| Dim numStandbyDuties As Integer | |
| numStandbyDuties = 0 | |
| Dim overUnder As Double | |
| ' Track unfulfilled duties to swap | |
| Dim cont As Boolean | |
| Dim ds As DutySlot ' Create ds object from the DutySlot class module | |
| ' Iterative variables | |
| Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer | |
| Dim slotPointsBackup(2) As Integer | |
| numPersonnel = 0 | |
| numSlots = 0 | |
| numStandbySlots = 0 | |
| slotPoints(0) = 0 | |
| slotPoints(1) = 0 | |
| slotPoints(2) = 0 | |
| numRows = countRows ' numRows = 52 | |
| Set log = New Logger ' Create new Logger object | |
| log.clearLog ' Clear screen | |
| 'log.log ("Number of duties per day: " & numDutyCols) | |
| Dim dayHasDuty As Boolean | |
| ' ================= Count total points, number of slots, load all ACTIVE slots ================= | |
| i = 0 | |
| While (i < numRows) ' i < 52 | |
| currentRow = dutySlotsStartRow + i ' currentRow = 3 + i(0) | |
| dayHasDuty = False ' If cell is not black | |
| j = 0 | |
| While (j < numDutyCols) ' j < 2 | |
| '(3 , 3 + 2 * 0 ) | |
| If (Worksheets(dutySlotsSheet).Cells(currentRow, firstActualCol + 2 * j).Interior.Color <> RGB(0, 0, 0)) Then | |
| dayHasDuty = True | |
| End If | |
| j = j + 1 | |
| Wend | |
| If (dayHasDuty) Then | |
| j = 0 | |
| While (j < numDutyCols) ' j < 2 | |
| '(3 , 3 + 2 * 0 ) | |
| If (Worksheets(dutySlotsSheet).Cells(currentRow, firstActualCol + 2 * j).Interior.Color <> RGB(0, 0, 0)) Then ' Unarmed | |
| ' If the day has duty aka not in black colour, the slotPoint will be added up | |
| ' slotPoint can only be either 1 or 2. | |
| slotPoint = Worksheets(dutySlotsSheet).Cells(currentRow, pointsCol).Value | |
| totalPoints = totalPoints + slotPoint ' Count the total number of points. | |
| numDuties = numDuties + 1 ' Add the duties | |
| slotPoints(slotPoint) = slotPoints(slotPoint) + 1 ' Add the points for slotPoints(1) And slotPoints(2) | |
| ' Create an object of DutySlot with every slot available (not black in colour) | |
| Set slots(numSlots) = New DutySlot | |
| ' Initialise the slot by calling the initialize function from DutySlot Class Module | |
| Call slots(numSlots).initialize(currentRow, firstActualCol + 2 * j) | |
| slots(numSlots).coordinateX = currentRow | |
| slots(numSlots).coordinateY = firstActualCol + 2 * j | |
| ' Increment the next slot | |
| numSlots = numSlots + 1 | |
| End If | |
| j = j + 1 | |
| Wend | |
| End If | |
| i = i + 1 | |
| Wend | |
| ' ================= Count total points, number of slots, load all STANDBY slots ================= | |
| i = 0 | |
| While (i < numRows) 'numRows = 89 | |
| currentRow = dutySlotsStartRow + i ' currentRow = 3 + i(0) | |
| dayHasDuty = False ' If cell is not black | |
| j = 0 | |
| While (j < numDutyCols) ' j < 2 | |
| '(3 , 4 + 2 * 0 ) | |
| If (Worksheets(dutySlotsSheet).Cells(currentRow, firstStbCol + 2 * j).Interior.Color <> RGB(0, 0, 0)) Then | |
| dayHasDuty = True | |
| End If | |
| j = j + 1 | |
| Wend | |
| If (dayHasDuty) Then | |
| j = 0 | |
| While (j < numDutyCols) ' j < 2 | |
| '(3 , 4 + 2 * 0 ) | |
| If (Worksheets(dutySlotsSheet).Cells(currentRow, firstStbCol + 2 * j).Interior.Color <> RGB(0, 0, 0)) Then ' Unarmed | |
| ' If the day has duty aka not in black colour, the slotPoint will be added up | |
| ' slotPoint can only be either 1 or 2. | |
| 'slotPoint = Worksheets(dutySlotsSheet).Cells(currentRow, pointsCol).Value | |
| 'totalPoints = totalPoints + slotPoint ' Count the total number of points. | |
| numStandbyDuties = numStandbyDuties + 1 ' Add the duties | |
| 'slotPoints(slotPoint) = slotPoints(slotPoint) + 1 ' Add the points for slotPoints(1) And slotPoints(2) | |
| ' Create an object of DutySlot with every slot available (not black in colour) | |
| Set standbySlots(numStandbySlots) = New DutySlot | |
| ' Initialise the slot by calling the initialize function | |
| ' from DutySlot Class Module | |
| Call standbySlots(numStandbySlots).initialize(currentRow, firstStbCol + 2 * j) | |
| standbySlots(numStandbySlots).coordinateX = currentRow | |
| standbySlots(numStandbySlots).coordinateY = firstStbCol + 2 * j | |
| ' Increment the next slot | |
| numStandbySlots = numStandbySlots + 1 | |
| End If | |
| j = j + 1 | |
| Wend | |
| End If | |
| i = i + 1 | |
| Wend | |
| ' TODO : What is the slotPointsBackup(0), slotPointsBackup(1), slotPointsBackup(2) | |
| ' ================= Create backup for slotPoints, not sure why ? ================= | |
| i = 0 | |
| While (i < 3) | |
| slotPointsBackup(i) = slotPoints(i) | |
| i = i + 1 | |
| Wend | |
| overUnder = totalPoints / numDuties | |
| log.log ("Total Actual Points: " & totalPoints) | |
| log.log ("Total Actual Duties: " & numDuties) | |
| log.log ("Actual Avg Points Per Slot: " & overUnder) | |
| log.log ("Total Standby Duties: " & numStandbyDuties) | |
| ' ================= Load all the guards from Points Table ================= | |
| Dim n As Integer | |
| n = PointsTable.countRows ' n = 41 | |
| i = 0 | |
| Dim dp As DutyPersonnel | |
| While (i < n) ' While (0...40 < 41) | |
| ' Don't count guards who have exemptions ' dutyType = GUARD | |
| If (Not DutyExemptions.PersonnelHasExemption(PointsTable.getName(i + 2)) And PointsTable.getDutyType(i + 2) = dutyType) Then | |
| ' Create new guards objects from DutyPersonnel Class Module | |
| Set personnel(numPersonnel) = New DutyPersonnel | |
| personnel(numPersonnel).initialize (PointsTable.getName(i + 2)) | |
| numPersonnel = numPersonnel + 1 | |
| End If | |
| i = i + 1 | |
| Wend | |
| log.log ("Number of Duty Personnel: " & numPersonnel) ' numPersonnel = 41 | |
| log.log ("Points Per Person: " & (totalPoints / numPersonnel) & vbCrLf) ' vbCrLf means press Enter | |
| ' This subroutine sorts the personnel by duty points in a decreasing order. | |
| sortPersonnelByPoints | |
| ' Remove extras from assigning list | |
| slotPoints(2) = slotPoints(2) - DutyExtras.CountTotalMonthExtras | |
| ' Debug.Print slotPoints(0) = 0 | |
| ' Debug.Print slotPoints(1) = 40 | |
| ' Debug.Print slotPoints(2) = 12 | |
| If (slotPoints(2) < 0) Then slotPoints(2) = 0 | |
| ' ================================== Setup slots ================================== | |
| Dim currentDay As Integer | |
| Dim numVolunteers As Integer | |
| numVolunteers = 0 | |
| ' This whole While ... Wend chunk of code is for | |
| ' 1) *** Calculating the difficulty of a slot to be assigned to guards ******************** | |
| ' 2) Allocating volunteer duties | |
| ' Note : i is for iterating slots; j is for iterating guards personnel | |
| i = 0 | |
| While (i < numSlots) ' While (0 ... 51 < 52 free slots where guards will be assigned) | |
| currentDay = slots(i).day ' TODO : This is NOT currentDay (Mon, Tue, Wed ...), | |
| ' it is current Date (1st, 2nd, 3rd). | |
| j = 0 | |
| While (j < numPersonnel) ' While (0 ... 40 < 41) | |
| ' If personnel A ... AO has committment on the 2nd Then add 1 to the slots(0).difficulty variable. | |
| ' This repeat for all the 52 slots. | |
| ' If personnel A ... AO has committment on the 2nd Then add 1 to the slots(1).difficulty variable. | |
| ' If personnel A ... AO has committment on the 2nd Then add 1 to the slots(2).difficulty variable. | |
| If (personnel(j).getCommitment(currentDay)) Then ' Set difficulty | |
| ' If the personnel A has committments for example on the 2nd date of the month, | |
| ' add 1 to the Actual guard slot on the 2nd. This will loop for all 41 guards. | |
| slots(i).difficulty = slots(i).difficulty + 1 | |
| End If | |
| ' Set volunteer | |
| If (personnel(j).getVolunteer(currentDay) And Not personnel(j).getDutyDay(currentDay)) Then | |
| slots(i).setVolunteer (personnel(j).name) | |
| personnel(j).addDutyDay (currentDay) | |
| End If | |
| j = j + 1 | |
| Wend | |
| ' ================= Pre-allocated / Volunteer personnel ================= | |
| If (slots(i).personnel <> "") Then ' If slots(0).personnel is Not Equal to empty string which means | |
| ' it has some name of a duty personnel aka Pre-allocated/Volunteer personnel. | |
| j = 0 ' j is for iterating guards personnel | |
| While (j < numPersonnel) ' 0 ... 40 < 41 | |
| If (personnel(j).name = slots(i).personnel) Then ' If personnel(0).name = slots(0).personnel Then | |
| ' which means it has found the name of the personnel. | |
| slots(i).setVolunteer (personnel(j).name) | |
| slotPoints(slots(i).points) = slotPoints(slots(i).points) - 1 | |
| numVolunteers = numVolunteers + 1 | |
| If (personnel(j).getVolunteer(slots(i).day)) Then | |
| log.log (personnel(j).name & " volunteered On " & currentDay) | |
| Else | |
| log.log (personnel(j).name & " was pre-assigned On " & currentDay) | |
| End If | |
| ' The below 2 lines are subtracted and added up the points for that day.. | |
| ' Debug.Print slotPoints(0) = 0 | |
| ' Debug.Print slotPoints(1) = 40 | |
| ' Debug.Print slotPoints(2) = 12 | |
| personnel(j).removeDuty (slots(i).points) | |
| personnel(j).addDutyDay (slots(i).day) | |
| slots(i).locked = True | |
| End If | |
| j = j + 1 | |
| Wend | |
| End If | |
| i = i + 1 | |
| Wend | |
| ' ================= Assign a number of duties to guards ================= | |
| ' Assign guards with 2 point slots. If the total number of 2 point slots are empty | |
| ' then Assign guards with 1 point slots. | |
| ' slotPoints(2)-- Then slotPoints(1)-- | |
| Dim cpp As Integer ' Current Planning Points (points of the slot) | |
| Dim currIndex As Integer | |
| Dim breakPoint As Integer | |
| breakPoint = -1 | |
| cpp = 2 | |
| currIndex = numPersonnel - 1 ' 40 = 41 - 1 | |
| i = 0 | |
| ' Debug.Print numDuties - DutyExtras.CountTotalMonthExtras - numVolunteers | |
| ' (i < 52 - 0 - 49) | |
| While (i < numDuties - DutyExtras.CountTotalMonthExtras - numVolunteers) | |
| If (cpp = 2) Then | |
| personnel(currIndex).addDuty (cpp) ' personnel(40).addDuty(2) | |
| slotPoints(cpp) = slotPoints(cpp) - 1 ' slotPoints(2) = slotPoints(2) - 1 | |
| ElseIf (cpp = 1) Then | |
| 'If (personnel(currIndex).numberOfDutiesWithPoints(2) > 0 Or slotPoints(cpp) = 1) Then | |
| personnel(currIndex).addDuty (cpp) | |
| slotPoints(cpp) = slotPoints(cpp) - 1 | |
| 'Else | |
| ' personnel(currIndex).addDuty (cpp) | |
| ' personnel(currIndex).addDuty (cpp) | |
| ' slotPoints(cpp) = slotPoints(cpp) - 2 | |
| ' i = i + 1 | |
| 'End If | |
| End If | |
| If (slotPoints(cpp) = 0) Then ' If (slotPoints(2) = 0) Then | |
| cpp = cpp - 1 ' after all the '2 point' slots are assigned to guards | |
| ' move on to '1 point' slots. | |
| ' The below line means that if slotsPoints(cpp) = slotPoints(1) and there are guards | |
| ' left over Then set breakPoint = currIndex - 1 | |
| If (cpp = 1 And currIndex > 0) Then breakPoint = currIndex - 1 | |
| End If | |
| currIndex = currIndex - 1 ' 39 = 40 -1 | |
| If (currIndex = -1) Then | |
| If (breakPoint = -1) Then | |
| currIndex = numPersonnel - 1 | |
| Else | |
| currIndex = breakPoint | |
| If (personnel(currIndex).numberOfDutiesWithPoints(1) >= 2) Then | |
| currIndex = numPersonnel - 1 | |
| End If | |
| End If | |
| End If | |
| ' Debug.Print i ' i = 0, i = 1, i = 1 | |
| i = i + 1 | |
| Wend | |
| ' ================= Balance guard duties based on PPM values ================= | |
| cont = True | |
| currIndex = numPersonnel - 1 ' 40 = 41 - 1 | |
| i = 0 | |
| 'Debug.Print "personnel(40).totalPoints", personnel(currIndex).totalPoints ' = 2 Based on duties assigned | |
| 'Debug.Print "personnel(0).totalPoints", personnel(i).totalPoints ' = 0 Based on duties assigned | |
| 'Debug.Print "personnel(0).dutyPoints", personnel(i).dutyPoints ' = 10 (PPM) | |
| 'Debug.Print "personnel(40).dutyPoints", personnel(currIndex).dutyPoints ' = 0.182 (PPM) | |
| While (cont) ' While(True) | |
| ' If 2 personnel have the same number of totalPoints And both of their dutyPoints > 0 Then | |
| ' goto the next If statement. | |
| If (personnel(currIndex).totalPoints = personnel(i).totalPoints And personnel(i).dutyPoints > 0 And personnel(currIndex).dutyPoints > 0) Then | |
| '(10 - 0.182) / 10 -- What's this formula ? | |
| ' The personnel who has more dutyPoints will be swapped with personnel | |
| ' who has less dutyPoints if this condition is met (personnel(i).numberOfDutiesWithPoints(1) > 0) | |
| If ((personnel(i).dutyPoints - personnel(currIndex).dutyPoints) / personnel(i).dutyPoints > 0.1) Then | |
| If (personnel(i).numberOfDutiesWithPoints(1) > 0) Then | |
| personnel(i).removeDuty (1) ' Swap duty with personnel who has less dutyPoints | |
| personnel(currIndex).addDuty (1) | |
| End If | |
| End If | |
| Else | |
| cont = False | |
| End If | |
| ' Compare the guards from 0,1,2,3 and the guards from 40,39,38,37. | |
| ' Compare guards 0 And 40 , 1 And 39 , 2 And 38 ... | |
| currIndex = currIndex - 1 | |
| i = i + 1 | |
| Wend | |
| ' ================= Assign extras ================= | |
| i = 0 | |
| Dim numExtras As Integer | |
| While (i < numPersonnel) ' While (i < 41) | |
| j = 0 | |
| ' Count the total number of Extras | |
| numExtras = DutyExtras.PersonnelNumExtras(personnel(i).name) | |
| While (j < numExtras) | |
| ' Assign the personnel who has extras with 2 points | |
| personnel(i).addDuty (2) | |
| ' log to main screen | |
| log.log (personnel(i).name & " has extra") | |
| j = j + 1 | |
| Wend | |
| i = i + 1 | |
| Wend | |
| ' ================ Backup slotPoints ================ | |
| i = 0 | |
| While (i < 3) | |
| slotPoints(i) = slotPointsBackup(i) | |
| i = i + 1 | |
| Wend | |
| ' ================= Assign standbys ================= | |
| ' This subroutine sorts the personnel by duty points in an increasing order. | |
| sortPersonnelByPointsReverse | |
| cpp = 2 | |
| currIndex = numPersonnel - 1 ' 40 = 41 - 1 | |
| i = 0 | |
| While (i < numDuties) ' While (i < 52) | |
| If (cpp = 2) Then | |
| personnel(currIndex).addStandby (cpp) | |
| slotPoints(cpp) = slotPoints(cpp) - 1 | |
| ElseIf (cpp = 1) Then | |
| If (personnel(currIndex).numberOfDutiesWithPoints(2) > 0 Or slotPoints(cpp) = 1) Then | |
| personnel(currIndex).addStandby (cpp) | |
| slotPoints(cpp) = slotPoints(cpp) - 1 | |
| Else | |
| personnel(currIndex).addStandby (cpp) | |
| personnel(currIndex).addStandby (cpp) | |
| slotPoints(cpp) = slotPoints(cpp) - 2 | |
| i = i + 1 | |
| End If | |
| End If | |
| If (slotPoints(cpp) = 0) Then | |
| cpp = cpp - 1 ' cpp = 2 - 1 | |
| End If | |
| currIndex = currIndex - 1 | |
| If (currIndex = -1) Then currIndex = numPersonnel - 1 | |
| i = i + 1 | |
| Wend | |
| ' This subroutine sorts all 52 slots in a decreasing order of number of points. | |
| sortSlotsByPoints | |
| ' Sort slots and personnel by difficulty. | |
| ' The personnel who has many committments will have a higher number of pDifficulty value | |
| ' than a personnel who has little committments. Therefore, sort the pDifficulty in a | |
| ' decreasing order. | |
| sortPersonnelByDifficulty | |
| ' Print "" to the cell. | |
| log.log ("") | |
| ' ======================== Assign Actual duties and stand-by duties(shankar edits) ======================== | |
| Dim numDutiesToAssign() As Integer | |
| Dim foundPersonnel As Boolean | |
| Dim hasClash As Boolean | |
| Dim hasMissingSlot As Boolean | |
| hasMissingSlot = True | |
| Dim numRetries As Integer | |
| numRetries = 0 | |
| Dim errorLog(255) As String | |
| Dim numErrors As Integer | |
| numErrors = 0 | |
| 'backtracking variables | |
| Dim tempValue(255) As Integer | |
| Dim slotday(255) As Integer | |
| Dim another_c As Integer | |
| Dim another_day As Integer | |
| Dim another_i As Integer | |
| Dim another_lastday As Integer | |
| another_lastday = 1 | |
| 'get the largest value for another_day' | |
| For another_i = 1 To numDuties - 1 '21 | |
| If slots(another_i).day > another_lastday Then | |
| another_lastday = slots(another_i).day 'another_lastday is 30 | |
| End If | |
| Next another_i | |
| ' Print slot number, day, coordinateX, coordinateY | |
| 'For another_i = 1 To numDuties - 1 | |
| 'Debug.Print "slot number : ", another_i, " Day : ", slots(another_i).day, slots(another_i).coordinateX, slots(another_i).coordinateY; "" | |
| 'Next | |
| ' ==================== Summary of the below code ==================== | |
| ' It does a "best FIRST attempt" by filling in people with the worst availability | |
| ' into the slots that fewest people are available. | |
| ' While ( True And 0 < 1 ) | |
| While (hasMissingSlot And numRetries < 1) | |
| hasMissingSlot = False | |
| numRetries = numRetries + 1 | |
| numErrors = 0 | |
| ' This While...Wend loop just assigns "" to the empty slots or unLocked slots | |
| i = 0 | |
| While (i < numSlots) ' While (i < 52 free slots where guards will be assigned) | |
| If (Not slots(i).locked) Then | |
| slots(i).personnel = "" 'Assign "" the slot which is not assigned to any personnel | |
| slots(i).standby = "" | |
| End If | |
| i = i + 1 'Loop i from 0 to 51 aka loop 52 times | |
| Wend | |
| ' backup.vb | |
| ' backTracking | |
| ' =================================================================================================== | |
| i = 0 ' i is numSlots | |
| l = 0 ' l is numPersonnel | |
| While (i < numSlots And i >= 0) ' 0 To 51, Loop through each of the 52 slots | |
| l = 0 ' l is numPersonnel | |
| While (l < numPersonnel) ' 0...40 < 41 ,Loop through each of the 41 total personnel | |
| numDutiesToAssign = personnel(l).numberOfDuties | |
| j = 1 ' j = 1 point WeekDay duties, j = 2 points WeekEnd duties | |
| While (j <= 2) ' Loop through each duty points 1 => Weekday, 2 => Weekend | |
| k = 0 | |
| ' While ( 0 ... < numDutiesToAssign(1) or numDutiesToAssign(2)) | |
| While (k < numDutiesToAssign(j)) ' Loop through each duty | |
| ' Need to place this somewhere Or maybe here' | |
| foundPersonnel = False | |
| ' Checks if there is a slot open or it has found solution | |
| ' If (Not False And slots(0).personnel = "" And slots(0).points = 1) Then | |
| If (Not foundPersonnel And slots(i).personnel = "" And slots(i).points = j) Then | |
| ' Check if we are able to assign the slot to the personnel' | |
| m = 0 | |
| hasClash = False | |
| ' (0 ... 51 < 52) | |
| ' Loop through each slot again to check for clashes too near to current slot | |
| While (m < numSlots) | |
| If (Abs(slots(i).day - slots(m).day) <= minDutyGap And personnel(l).name = slots(m).personnel) Then | |
| hasClash = True | |
| End If | |
| m = m + 1 | |
| Wend | |
| ' If the personnel has committment on that particular day, then hasClash = True | |
| If (personnel(l).getCommitment(slots(i).day)) Then hasClash = True | |
| ' If the personnel is able to take arms And | |
| ' the slot is an armed slot, | |
| ' then hasClash = False | |
| If (Not personnel(l).armed And slots(i).armed) Then | |
| hasClash = True | |
| End If | |
| If (Not hasClash) Then | |
| foundPersonnel = True | |
| slots(i).personnel = personnel(l).name | |
| ' This is the important part where we can randomise the slots. | |
| shuffleSlotsByDifficulty | |
| End If | |
| End If | |
| k = k + 1 | |
| Wend | |
| j = j + 1 | |
| Wend | |
| l = l + 1 | |
| Wend | |
| ' If personnel are still Not found after iterating through all 41 personnel Then | |
| ' hasMissingSlot = True, log to Guard Duty planner sheet increment numErrors by 1 | |
| i = i + 1 | |
| Wend | |
| ' ===================================================================================================== | |
| ' ======================== Assign standby duties ======================== | |
| ' This is the exact same code as before. The comments written previously apply here too. | |
| ' | |
| i = 0 | |
| While (i < numPersonnel) ' Loop through each of 41 personnel | |
| j = 1 | |
| 'Initially, numDutiesToAssign is 0. | |
| 'Subsequently, numDutiesToAssign is | |
| numDutiesToAssign = personnel(i).numberOfStandbys | |
| 'While (1 <= 2) | |
| While (j <= 2) ' Loop through each duty points | |
| ' k is an iterative variable. | |
| k = 0 | |
| While (k < numDutiesToAssign(j)) ' Loop through each 1 point / 2 points duty slot. | |
| l = 0 | |
| foundPersonnel = False | |
| While (l < numSlots) ' Loop through each slot | |
| ' Check if the slot is vacant or if there is a solution. | |
| If (Not foundPersonnel And slots(l).standby = "" And slots(l).points = j) Then | |
| m = 0 | |
| hasClash = False | |
| While (m < numSlots) ' Loop through each slot again to check for clashes with current slot | |
| If (Abs(slots(l).day - slots(m).day) <= minStbGap And personnel(i).name = slots(m).personnel) Then | |
| hasClash = True | |
| End If | |
| m = m + 1 | |
| Wend | |
| m = 0 | |
| ' Loop through each slot again to check for clashes w/ standby too near to current slot | |
| While (m < numSlots) | |
| If (Abs(slots(l).day - slots(m).day) <= minStbGap And personnel(i).name = slots(m).standby) Then | |
| hasClash = True | |
| End If | |
| m = m + 1 | |
| Wend | |
| If (personnel(i).getCommitment(slots(l).day)) Then hasClash = True | |
| If (Not personnel(i).armed And slots(l).armed) Then | |
| hasClash = True | |
| End If | |
| If (Not hasClash) Then | |
| foundPersonnel = True | |
| slots(l).standby = personnel(i).name | |
| shuffleSlotsByDifficulty | |
| End If | |
| End If | |
| l = l + 1 | |
| Wend | |
| If (Not foundPersonnel) Then | |
| hasMissingSlot = True | |
| ' log.log ("Unable to assign " & personnel(i).name & " to a " & j & " point standby slot") | |
| errorLog(numErrors) = "Unable To assign " & personnel(i).name & " To a " & j & " point standby slot" | |
| numErrors = numErrors + 1 | |
| End If | |
| k = k + 1 | |
| Wend | |
| j = j + 1 | |
| Wend | |
| i = i + 1 | |
| Wend | |
| Wend | |
| ' ======================== End of Assign Actual Duties And Assign stand-by ======================== | |
| ' log.log ("Retried " & numRetries & " times") | |
| If (hasMissingSlot) Then | |
| i = 0 | |
| While (i < numErrors) | |
| log.log (errorLog(i)) | |
| i = i + 1 | |
| Wend | |
| End If | |
| i = 0 | |
| While (i < numSlots) ' While (i < 52) | |
| slots(i).writeToDutyList | |
| ' Highlight empty slots in Duty Slots Table | |
| slots(i).HighlightEmpty ' I am commenting this | |
| 'log.log (i & "- " & slots(i).toString) | |
| i = i + 1 | |
| Wend | |
| ' This subroutine is useless. | |
| i = 0 | |
| While (i < numPersonnel) | |
| 'log.log (i & "- " & personnel(i).toString) | |
| i = i + 1 | |
| Wend | |
| ResetHighlightCommitments ' done by me | |
| ' POINT SYSTEM | |
| ' Existing points (lower ppm, higher points) | |
| ' Duty commitments (more days away, higher points) | |
| ' Armed (non-armed +++++++ points make sure put first) | |
| ' Validate slot variables | |
| Dim validate_counter_1 As Integer | |
| Dim availablePersonnel As Long | |
| ' First Condition -- Active slots | |
| i = 0 | |
| While (i < numSlots) ' numSlots = Active slots | |
| ' Day 1, Worksheets(dutySlotsSheet).Cells(slots(another_c).coordinateX, slots(another_c).coordinateY).Interior.ColorIndex = 3 | |
| ' Debug.Print "slot number : ", another_c, " Day : ", slots(another_c).day, slots(another_c).coordinateX, slots(another_c).coordinateY; "" | |
| If (slots(i).personnel = "") Then | |
| ' reassign availablePersonnel = 0 for every slot iteration | |
| availablePersonnel = 0 | |
| validate_counter_1 = 0 | |
| ' Count the number of available personnel on that day. | |
| While (validate_counter_1 < numPersonnel) | |
| If (Not personnel(validate_counter_1).getCommitment(slots(i).day)) Then | |
| availablePersonnel = availablePersonnel + 1 | |
| End If | |
| validate_counter_1 = validate_counter_1 + 1 | |
| Wend | |
| If (availablePersonnel = 0) Then | |
| Worksheets(dutySlotsSheet).Cells(slots(i).coordinateX, slots(i).coordinateY).Interior.ColorIndex = 3 | |
| Else | |
| For another_c = 0 To numSlots - 1 | |
| If (slots(another_c).day = slots(i).day) Then | |
| 'Debug.Print "slot number : ", another_c, " Day : ", slots(another_c).day, slots(another_c).coordinateX, slots(another_c).coordinateY; "" | |
| If (slots(another_c).personnel <> "") Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(slots(i).coordinateX, slots(i).coordinateY).Interior.ColorIndex = 3 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| For another_c = 0 To numStandbySlots - 1 | |
| If (standbySlots(another_c).day = slots(i).day) Then | |
| 'Debug.Print "slot number : ", another_c, " Day : ", slots(another_c).day, slots(another_c).coordinateX, slots(another_c).coordinateY; "" | |
| If (standbySlots(another_c).personnel <> "") Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(slots(i).coordinateX, slots(i).coordinateY).Interior.ColorIndex = 3 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| End If | |
| ' 2nd condition - Active Slots | |
| ' Check the PREVIOUS day | |
| ' Compare with Active Slots | |
| validate_counter_1 = 0 | |
| 'Loop all the available personnel on that day | |
| While (validate_counter_1 < numPersonnel) | |
| If (Not personnel(validate_counter_1).getCommitment(slots(i).day)) Then | |
| For another_c = 0 To numSlots - 1 | |
| If (slots(another_c).day = slots(i).day - 1) Then | |
| If (slots(another_c).personnel = personnel(validate_counter_1).name) Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(slots(i).coordinateX, slots(i).coordinateY).Interior.ColorIndex = 50 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| End If | |
| validate_counter_1 = validate_counter_1 + 1 | |
| Wend | |
| ' Compare with Standby Slots | |
| validate_counter_1 = 0 | |
| 'Loop all the available personnel on that day | |
| While (validate_counter_1 < numPersonnel) | |
| If (Not personnel(validate_counter_1).getCommitment(slots(i).day)) Then | |
| For another_c = 0 To numStandbySlots - 1 | |
| If (standbySlots(another_c).day = slots(i).day - 1) Then | |
| If (standbySlots(another_c).personnel = personnel(validate_counter_1).name) Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(slots(i).coordinateX, slots(i).coordinateY).Interior.ColorIndex = 50 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| End If | |
| validate_counter_1 = validate_counter_1 + 1 | |
| Wend | |
| ' Check the NEXT day | |
| ' Compare with Active Slots | |
| validate_counter_1 = 0 | |
| 'Loop all the available personnel on that day | |
| While (validate_counter_1 < numPersonnel) | |
| If (Not personnel(validate_counter_1).getCommitment(slots(i).day)) Then | |
| For another_c = 0 To numSlots - 1 | |
| If (slots(another_c).day = slots(i).day + 1) Then | |
| If (slots(another_c).personnel = personnel(validate_counter_1).name) Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(slots(i).coordinateX, slots(i).coordinateY).Interior.ColorIndex = 50 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| End If | |
| validate_counter_1 = validate_counter_1 + 1 | |
| Wend | |
| ' Compare with Standby Slots | |
| validate_counter_1 = 0 | |
| 'Loop all the available personnel on that day | |
| While (validate_counter_1 < numPersonnel) | |
| If (Not personnel(validate_counter_1).getCommitment(slots(i).day)) Then | |
| For another_c = 0 To numStandbySlots - 1 | |
| If (standbySlots(another_c).day = slots(i).day + 1) Then | |
| If (standbySlots(another_c).personnel = personnel(validate_counter_1).name) Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(slots(i).coordinateX, slots(i).coordinateY).Interior.ColorIndex = 50 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| End If | |
| validate_counter_1 = validate_counter_1 + 1 | |
| Wend | |
| End If | |
| i = i + 1 | |
| Wend | |
| ' First Condition -- Standby slots | |
| i = 0 | |
| While (i < numStandbySlots) | |
| If (standbySlots(i).personnel = "") Then | |
| ' reassign availablePersonnel = 0 for every slot iteration | |
| availablePersonnel = 0 | |
| validate_counter_1 = 0 | |
| ' Count the number of available personnel on that day. | |
| While (validate_counter_1 < numPersonnel) | |
| If (Not personnel(validate_counter_1).getCommitment(standbySlots(i).day)) Then | |
| availablePersonnel = availablePersonnel + 1 | |
| End If | |
| validate_counter_1 = validate_counter_1 + 1 | |
| Wend | |
| If (availablePersonnel = 0) Then | |
| Worksheets(dutySlotsSheet).Cells(standbySlots(i).coordinateX, standbySlots(i).coordinateY).Interior.ColorIndex = 3 | |
| Else | |
| For another_c = 0 To numStandbySlots - 1 | |
| If (standbySlots(another_c).day = standbySlots(i).day) Then | |
| 'Debug.Print "standbySlots number : ", another_c, " Day : ", standbySlots(another_c).day, standbySlots(another_c).coordinateX, standbySlots(another_c).coordinateY; "" | |
| If (standbySlots(another_c).personnel <> "") Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(standbySlots(i).coordinateX, standbySlots(i).coordinateY).Interior.ColorIndex = 3 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| For another_c = 0 To numSlots - 1 | |
| If (slots(another_c).day = standbySlots(i).day) Then | |
| 'Debug.Print "slot number : ", another_c, " Day : ", slots(another_c).day, slots(another_c).coordinateX, slots(another_c).coordinateY; "" | |
| If (slots(another_c).personnel <> "") Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(standbySlots(i).coordinateX, standbySlots(i).coordinateY).Interior.ColorIndex = 3 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| End If | |
| ' 2nd condition - Standby Slots | |
| ' Check the PREVIOUS day | |
| ' Compare with Standby Slots | |
| validate_counter_1 = 0 | |
| 'Loop all the available personnel on that day | |
| While (validate_counter_1 < numPersonnel) | |
| If (Not personnel(validate_counter_1).getCommitment(standbySlots(i).day)) Then | |
| For another_c = 0 To numStandbySlots - 1 | |
| If (standbySlots(another_c).day = standbySlots(i).day - 1) Then | |
| If (standbySlots(another_c).personnel = personnel(validate_counter_1).name) Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(standbySlots(i).coordinateX, standbySlots(i).coordinateY).Interior.ColorIndex = 50 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| End If | |
| validate_counter_1 = validate_counter_1 + 1 | |
| Wend | |
| ' Compare with Active Slots | |
| validate_counter_1 = 0 | |
| 'Loop all the available personnel on that day | |
| While (validate_counter_1 < numPersonnel) | |
| If (Not personnel(validate_counter_1).getCommitment(standbySlots(i).day)) Then | |
| For another_c = 0 To numSlots - 1 | |
| If (slots(another_c).day = standbySlots(i).day - 1) Then | |
| If (slots(another_c).personnel = personnel(validate_counter_1).name) Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(standbySlots(i).coordinateX, standbySlots(i).coordinateY).Interior.ColorIndex = 50 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| End If | |
| validate_counter_1 = validate_counter_1 + 1 | |
| Wend | |
| ' Check the NEXT day | |
| ' Compare with Standby Slots | |
| validate_counter_1 = 0 | |
| 'Loop all the available personnel on that day | |
| While (validate_counter_1 < numPersonnel) | |
| If (Not personnel(validate_counter_1).getCommitment(standbySlots(i).day)) Then | |
| For another_c = 0 To numStandbySlots - 1 | |
| If (standbySlots(another_c).day = standbySlots(i).day + 1) Then | |
| If (standbySlots(another_c).personnel = personnel(validate_counter_1).name) Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(standbySlots(i).coordinateX, standbySlots(i).coordinateY).Interior.ColorIndex = 50 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| End If | |
| validate_counter_1 = validate_counter_1 + 1 | |
| Wend | |
| ' Compare with Active Slots | |
| validate_counter_1 = 0 | |
| 'Loop all the available personnel on that day | |
| While (validate_counter_1 < numPersonnel) | |
| If (Not personnel(validate_counter_1).getCommitment(standbySlots(i).day)) Then | |
| For another_c = 0 To numSlots - 1 | |
| If (slots(another_c).day = standbySlots(i).day + 1) Then | |
| If (slots(another_c).personnel = personnel(validate_counter_1).name) Then | |
| availablePersonnel = availablePersonnel - 1 | |
| If (availablePersonnel <= 0) Then | |
| Worksheets(dutySlotsSheet).Cells(standbySlots(i).coordinateX, standbySlots(i).coordinateY).Interior.ColorIndex = 50 | |
| End If | |
| End If | |
| End If | |
| Next another_c | |
| End If | |
| validate_counter_1 = validate_counter_1 + 1 | |
| Wend | |
| End If | |
| i = i + 1 | |
| Wend | |
| ' Print slot number, day, coordinateX, coordinateY | |
| 'For another_i = 1 To numStandbyDuties - 1 | |
| 'Debug.Print "standbySlots number : ", another_i, " Day : ", standbySlots(another_i).day, standbySlots(another_i).coordinateX, standbySlots(another_i).coordinateY; "" | |
| 'Next | |
| ' Assign points to everyone based on their PPM (points per month) | |
| End Sub | |
| ' Add duty records from the filled duty slots into the duty records sheet | |
| Sub AddDutyRecords() | |
| initVars | |
| Dim numRows As Integer | |
| Dim currentRow As Integer | |
| Dim currentCol As Integer | |
| Dim checkCol As Integer | |
| Dim hasClash As Boolean | |
| Dim i As Integer, j As Integer | |
| Dim dayHasDuty As Boolean | |
| numRows = countRows | |
| ' Loop through each row | |
| i = 0 | |
| While (i < numRows) | |
| currentRow = dutySlotsStartRow + i | |
| ' If cell is not black | |
| dayHasDuty = False | |
| j = 0 | |
| While (j < numDutyCols) | |
| If (Worksheets(dutySlotsSheet).Cells(currentRow, firstActualCol + 2 * j).Interior.Color <> RGB(0, 0, 0)) Then dayHasDuty = True | |
| j = j + 1 | |
| Wend | |
| If (dayHasDuty) Then | |
| j = 0 | |
| While (j < numDutyCols) | |
| If (Worksheets(dutySlotsSheet).Cells(currentRow, firstActualCol + 2 * j).Interior.Color <> RGB(0, 0, 0)) Then | |
| DutyRecords.AddDutyRecord Worksheets(dutySlotsSheet).Cells(currentRow, firstActualCol + 2 * j).Value, Worksheets(dutySlotsSheet).Range(monthCell).Value, dutyType, Worksheets(dutySlotsSheet).Cells(currentRow, pointsCol).Value | |
| End If | |
| j = j + 1 | |
| Wend | |
| End If | |
| i = i + 1 | |
| Wend | |
| End Sub | |
| ' Check for errors in the current duty slots | |
| Sub CheckForErrors() | |
| initVars | |
| Dim numRows As Integer | |
| Dim currentRow As Integer | |
| Dim currentCol As Integer | |
| Dim checkCol As Integer | |
| Dim hasClash As Boolean | |
| Dim dayHasDuty As Boolean | |
| Dim i As Integer, j As Integer | |
| numRows = countRows | |
| ' Loop through each row | |
| i = 0 | |
| While (i < numRows) | |
| currentRow = dutySlotsStartRow + i | |
| ' Keep track of clashes | |
| hasClash = False | |
| dayHasDuty = False | |
| j = 0 | |
| While (j < numDutyCols) | |
| If (Worksheets(dutySlotsSheet).Cells(currentRow, firstActualCol + 2 * j).Interior.Color <> RGB(0, 0, 0)) Then dayHasDuty = True | |
| j = j + 1 | |
| Wend | |
| ' If cell is not black | |
| If (dayHasDuty) Then | |
| ' Define checking range | |
| Dim checkRowFirst As Integer | |
| Dim checkRow As Integer | |
| checkRowFirst = currentRow - 2 | |
| If (checkRowFirst < dutySlotsStartRow) Then | |
| checkRowFirst = dutySlotsStartRow | |
| End If | |
| Dim checkRowLast As Integer | |
| checkRowLast = currentRow + 2 | |
| ' Check all 4 col | |
| currentCol = firstActualCol | |
| While (currentCol < pointsCol) | |
| ' Check that the cell we're checking is not blank | |
| If (Worksheets(dutySlotsSheet).Cells(currentRow, currentCol).Value <> "") Then | |
| ' Loop through each row and col | |
| checkCol = firstCheckCol | |
| While (checkCol < pointsCol) | |
| ' Loop through +- 2 from current row | |
| checkRow = checkRowFirst | |
| While (checkRow < checkRowLast + 1) | |
| 'MsgBox ("checking row " & checkRow & " col " & checkCol) | |
| ' Don't check against itself | |
| If Not (currentRow = checkRow And currentCol = checkCol) Then | |
| ' Check for clash | |
| If (Worksheets(dutySlotsSheet).Cells(currentRow, currentCol).Value = Worksheets(dutySlotsSheet).Cells(checkRow, checkCol).Value) Then | |
| hasClash = True | |
| 'MsgBox ("CLASHING " & currentRow & ", " & currentCol & " with " & checkRow & ", " & checkCol) | |
| Worksheets(dutySlotsSheet).Cells(currentRow, currentCol).Interior.Color = RGB(255, 255, 0) | |
| End If | |
| End If | |
| checkRow = checkRow + 1 | |
| Wend | |
| checkCol = checkCol + 1 | |
| Wend | |
| End If | |
| currentCol = currentCol + 1 | |
| Wend | |
| End If | |
| If (hasClash) Then | |
| 'MsgBox ("Ouch! There's a clash at row " & currentRow) | |
| End If | |
| i = i + 1 | |
| Wend | |
| End Sub | |
| Sub FindUncommitted() | |
| initVars | |
| Dim selectedDate As Integer | |
| Dim output As String | |
| Dim i As Integer | |
| selectedDate = Worksheets(dutySlotsSheet).Cells(ActiveCell.Row, dateCol).Value | |
| ' Load everyone | |
| Dim n As Integer | |
| n = PointsTable.countRows | |
| i = 0 | |
| output = "Personnel without commitments:" & vbCrLf | |
| Dim dp As DutyPersonnel | |
| While (i < n) | |
| ' Don't count with exemptions | |
| If (Not DutyExemptions.PersonnelHasExemption(PointsTable.getName(i + 2)) And PointsTable.getDutyType(i + 2) = dutyType) Then | |
| Set personnel(numPersonnel) = New DutyPersonnel | |
| personnel(numPersonnel).initialize (PointsTable.getName(i + 2)) | |
| If (Not personnel(numPersonnel).getCommitment(selectedDate)) Then | |
| output = output & personnel(numPersonnel).name & vbCrLf | |
| End If | |
| numPersonnel = numPersonnel + 1 | |
| End If | |
| i = i + 1 | |
| Wend | |
| MsgBox (output) | |
| End Sub | |
| Sub HighlightCommitments() | |
| initVars | |
| Dim i As Integer, j As Integer | |
| Dim selectedPers As String | |
| Dim pers As DutyPersonnel | |
| Dim currentDate As Integer | |
| ResetHighlightCommitments | |
| selectedPers = Worksheets(dutySlotsSheet).Cells(ActiveCell.Row, ActiveCell.Column).Value | |
| Set pers = New DutyPersonnel | |
| pers.initialize (selectedPers) | |
| i = dutySlotsStartRow | |
| While (Worksheets(dutySlotsSheet).Cells(i, dateCol).Value <> "") | |
| currentDate = Worksheets(dutySlotsSheet).Cells(i, dateCol).Value | |
| If (pers.getCommitment(currentDate)) Then | |
| j = firstActualCol | |
| While (j < pointsCol) | |
| If (Worksheets(dutySlotsSheet).Cells(i, j).Interior.ColorIndex <> 1) Then | |
| Worksheets(dutySlotsSheet).Cells(i, j).Interior.ColorIndex = 27 | |
| End If | |
| j = j + 1 | |
| Wend | |
| End If | |
| i = i + 1 | |
| Wend | |
| End Sub | |
| Sub HighlightDuties() | |
| initVars | |
| Dim i As Integer, j As Integer | |
| Dim selectedPers As String | |
| ResetHighlightCommitments | |
| selectedPers = Worksheets(dutySlotsSheet).Cells(ActiveCell.Row, ActiveCell.Column).Value | |
| i = dutySlotsStartRow | |
| While (Worksheets(dutySlotsSheet).Cells(i, dateCol).Value <> "") | |
| j = firstActualCol | |
| While (j < pointsCol) | |
| If (Worksheets(dutySlotsSheet).Cells(i, j).Interior.ColorIndex <> 1) Then | |
| If (Worksheets(dutySlotsSheet).Cells(i, j).Value = selectedPers) Then | |
| Worksheets(dutySlotsSheet).Cells(i, j).Interior.ColorIndex = 27 | |
| End If | |
| End If | |
| j = j + 1 | |
| Wend | |
| i = i + 1 | |
| Wend | |
| End Sub | |
| Sub ResetHighlightCommitments() | |
| initVars | |
| Dim i As Integer, j As Integer | |
| Dim currentDay As String | |
| Dim colo As Integer | |
| i = dutySlotsStartRow | |
| While (Worksheets(dutySlotsSheet).Cells(i, dateCol).Value <> "") | |
| currentDay = Worksheets(dutySlotsSheet).Cells(i, dayCol).Value | |
| j = firstActualCol | |
| While (j < pointsCol) | |
| If (Worksheets(dutySlotsSheet).Cells(i, j).Interior.ColorIndex <> 1) Then | |
| If (currentDay = "SAT" Or currentDay = "SUN") Then | |
| Worksheets(dutySlotsSheet).Cells(i, j).Interior.ColorIndex = 15 | |
| Else | |
| Worksheets(dutySlotsSheet).Cells(i, j).Interior.ColorIndex = 0 | |
| End If | |
| If (Worksheets(dutySlotsSheet).Cells(i, j).Value = "") Then | |
| If (currentDay = "SAT" Or currentDay = "SUN") Then | |
| colo = 28 | |
| Else | |
| colo = 33 | |
| End If | |
| Worksheets(dutySlotsSheet).Cells(i, j).Interior.ColorIndex = colo | |
| End If | |
| End If | |
| j = j + 1 | |
| Wend | |
| i = i + 1 | |
| Wend | |
| End Sub | |
| Private Sub shuffleSlotsByDifficulty() | |
| ' A brief explanation: | |
| ' | |
| Dim i As Integer, j As Integer, k As Integer ' Iterative variables | |
| Dim tempslot As DutySlot | |
| Dim numDutiesWithDiff As Integer | |
| Dim currDiff As Double | |
| Dim toSwap1 As Integer | |
| Dim toSwap2 As Integer | |
| ' Call sortSlotsByDifficulty to arrange the slots based on the difficulty value. | |
| sortSlotsByDifficulty | |
| i = 2 | |
| j = 0 | |
| While (j < numSlots) ' While (0 ... 51 < 52) | |
| numDutiesWithDiff = 0 | |
| k = j ' k = 0 | |
| currDiff = slots(k).difficulty | |
| 'Debug.Print "currDiff = ", currDiff | |
| While (k < numSlots) ' While (0 < 52) | |
| If (slots(k).difficulty = currDiff) Then | |
| 'Debug.Print "k =", k, "slots(k).difficulty =", slots(k).difficulty | |
| numDutiesWithDiff = numDutiesWithDiff + 1 | |
| Else | |
| k = numSlots ' k = 52 | |
| End If | |
| k = k + 1 | |
| Wend | |
| 'Debug.Print "" | |
| ' This is the output of the above code | |
| ' currDiff = 41 | |
| ' k = 0 slots(k).difficulty = 41 | |
| ' currDiff = 32 | |
| ' k = 1 slots(k).difficulty = 32 | |
| ' currDiff = 30 | |
| 'k = 2 slots(k).difficulty = 30 | |
| 'k = 3 slots(k).difficulty = 30 | |
| 'k = 4 slots(k).difficulty = 30 | |
| 'k = 5 slots(k).difficulty = 30 | |
| 'k = 6 slots(k).difficulty = 30 | |
| 'k = 7 slots(k).difficulty = 30 | |
| 'k = 8 slots(k).difficulty = 30 | |
| 'k = 9 slots(k).difficulty = 30 | |
| 'k = 10 slots(k).difficulty = 30 | |
| 'k = 11 slots(k).difficulty = 30 | |
| 'k = 12 slots(k).difficulty = 30 | |
| 'k = 13 slots(k).difficulty = 30 | |
| 'k = 14 slots(k).difficulty = 30 | |
| 'k = 15 slots(k).difficulty = 30 | |
| 'k = 16 slots(k).difficulty = 30 | |
| 'k = 17 slots(k).difficulty = 30 | |
| 'k = 18 slots(k).difficulty = 30 | |
| 'currDiff = 28 | |
| 'k = 19 slots(k).difficulty = 28 | |
| 'k = 20 slots(k).difficulty = 28 | |
| 'k = 21 slots(k).difficulty = 28 | |
| 'k = 22 slots(k).difficulty = 28 | |
| 'k = 23 slots(k).difficulty = 28 | |
| 'k = 24 slots(k).difficulty = 28 | |
| 'k = 25 slots(k).difficulty = 28 | |
| 'k = 26 slots(k).difficulty = 28 | |
| 'k = 27 slots(k).difficulty = 28 | |
| 'k = 28 slots(k).difficulty = 28 | |
| 'currDiff = 22 | |
| 'k = 29 slots(k).difficulty = 22 | |
| 'currDiff = 21 | |
| 'k = 30 slots(k).difficulty = 21 | |
| 'k = 31 slots(k).difficulty = 21 | |
| 'k = 32 slots(k).difficulty = 21 | |
| 'k = 33 slots(k).difficulty = 21 | |
| 'k = 34 slots(k).difficulty = 21 | |
| 'k = 35 slots(k).difficulty = 21 | |
| 'k = 36 slots(k).difficulty = 21 | |
| 'k = 37 slots(k).difficulty = 21 | |
| 'k = 38 slots(k).difficulty = 21 | |
| 'k = 39 slots(k).difficulty = 21 | |
| 'currDiff = 20 | |
| 'k = 40 slots(k).difficulty = 20 | |
| 'k = 41 slots(k).difficulty = 20 | |
| 'k = 42 slots(k).difficulty = 20 | |
| 'k = 43 slots(k).difficulty = 20 | |
| 'k = 44 slots(k).difficulty = 20 | |
| 'k = 45 slots(k).difficulty = 20 | |
| 'k = 46 slots(k).difficulty = 20 | |
| 'k = 47 slots(k).difficulty = 20 | |
| 'k = 48 slots(k).difficulty = 20 | |
| 'k = 49 slots(k).difficulty = 20 | |
| 'currDiff = 2 | |
| 'k = 50 slots(k).difficulty = 2 | |
| 'k = 51 slots(k).difficulty = 2 | |
| ' Look here https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/rnd-function | |
| ' | |
| ' The Rnd function returns a value less than 1 but greater than or equal to zero. | |
| ' Before calling Rnd, use the Randomize statement without an argument to | |
| ' initialize the random-number generator with a seed based on the system timer. | |
| Randomize | |
| k = 0 | |
| While (k < 100) | |
| toSwap1 = j + CInt(Int(numDutiesWithDiff * Rnd())) | |
| toSwap2 = j + CInt(Int(numDutiesWithDiff * Rnd())) | |
| Set tempslot = slots(toSwap1) | |
| Set slots(toSwap1) = slots(toSwap2) | |
| Set slots(toSwap2) = tempslot | |
| k = k + 1 | |
| Wend | |
| j = j + numDutiesWithDiff | |
| Wend | |
| End Sub | |
| Private Sub sortPersonnelByPoints() | |
| ' This subroutine sorts the personnel by duty points in a decreasing order. | |
| Dim i As Integer, j As Integer | |
| Dim highestIndex As Integer | |
| Dim highestPoints As Double | |
| ' Create tempPersonnel object with DutyPersonnel class module | |
| Dim tempPersonnel As DutyPersonnel | |
| ' Sort personnel by points | |
| i = 0 | |
| While (i < numPersonnel - 1) ' While (i < 41 - 1) | |
| j = i ' j = 0 | |
| highestIndex = 0 | |
| highestPoints = -1 | |
| While (j < numPersonnel) ' While (j < 41) | |
| If (personnel(j).dutyPoints > highestPoints) Then | |
| highestPoints = personnel(j).dutyPoints | |
| highestIndex = j | |
| End If | |
| j = j + 1 | |
| Wend | |
| Set tempPersonnel = personnel(i) | |
| Set personnel(i) = personnel(highestIndex) | |
| Set personnel(highestIndex) = tempPersonnel | |
| i = i + 1 | |
| Wend | |
| End Sub | |
| Private Sub sortPersonnelByPointsReverse() | |
| ' Sort personnel by their duty points in a decreasing order. | |
| ' Example : personnel(0).dutyPoints = 10, personnel(1).dutyPoints = 3, personnel(2).dutyPoints = 1 | |
| Dim i As Integer, j As Integer | |
| Dim highestIndex As Integer | |
| Dim highestPoints As Double | |
| Dim tempPersonnel As DutyPersonnel | |
| ' Sort personnel by points | |
| i = 0 | |
| While (i < numPersonnel - 1) ' While (i < 41 - 1) | |
| j = i ' j = i = 0 | |
| highestIndex = 0 | |
| highestPoints = 999 | |
| While (j < numPersonnel) | |
| If (personnel(j).dutyPoints < highestPoints) Then | |
| highestPoints = personnel(j).dutyPoints | |
| highestIndex = j | |
| End If | |
| j = j + 1 | |
| Wend | |
| Set tempPersonnel = personnel(i) | |
| Set personnel(i) = personnel(highestIndex) | |
| Set personnel(highestIndex) = tempPersonnel | |
| i = i + 1 | |
| Wend | |
| End Sub | |
| Private Sub sortPersonnelByDifficulty() | |
| ' Iterative Variables | |
| Dim i As Integer, j As Integer | |
| Dim highestIndex As Integer | |
| Dim highestPoints As Integer | |
| Dim tempPersonnel As DutyPersonnel | |
| ' Sort personnel by difficulty aka | |
| i = 0 | |
| While (i < numPersonnel - 1) ' While (i < 41 - 1) | |
| j = i ' j = i = 0 | |
| highestIndex = 0 | |
| highestPoints = -1 | |
| While (j < numPersonnel) ' While (j < 41) | |
| ' personnel(?).difficulty is the total value of | |
| ' white cells present (the personnel has no committments for that following day) | |
| ' in the personnel's row in committments sheet. | |
| ' The personnel who has many committments will have a higher number | |
| ' than a personnel who has little committments. | |
| If (personnel(j).difficulty > highestPoints) Then | |
| highestPoints = personnel(j).difficulty | |
| highestIndex = j | |
| End If | |
| j = j + 1 | |
| Wend | |
| Set tempPersonnel = personnel(i) | |
| Set personnel(i) = personnel(highestIndex) | |
| Set personnel(highestIndex) = tempPersonnel | |
| i = i + 1 | |
| Wend | |
| End Sub | |
| Private Sub sortSlotsByDifficulty() | |
| ' ============ A brief explanation on what this subroutine does ============ | |
| ' 1 slot is defined as a column for a particular date, for example | |
| ' 1st of Nov, 2nd of Nov, 3rd of Nov and so on. | |
| ' | |
| ' In this column D for example, there are empty, P, SB slots from all 41 guards. | |
| ' Therefore, this subroutine sorts all 52 slots based on the availability of the guards | |
| ' in a decreasing order. | |
| ' If the availability of the guards is very low for that column, that slot will have a higher difficulty value. | |
| ' =========================================================================== | |
| Dim highestDiff As Integer | |
| Dim tempslot As DutySlot | |
| Dim highestIndex As Integer | |
| Dim i As Integer, j As Integer | |
| i = 0 | |
| While (i < numSlots - 1) ' While (0 .. 50 < 52 - 1) | |
| j = i ' j = i = 0 | |
| highestIndex = 0 | |
| highestDiff = -1 | |
| While (j < numSlots) ' While (0 ... 51 < 52) | |
| If (slots(j).difficulty > highestDiff) Then | |
| highestDiff = slots(j).difficulty | |
| highestIndex = j | |
| End If | |
| j = j + 1 | |
| Wend | |
| Set tempslot = slots(i) | |
| Set slots(i) = slots(highestIndex) | |
| Set slots(highestIndex) = tempslot | |
| i = i + 1 | |
| ' Debug.Print "i =", i | |
| ' Debug.Print "slots(i).day", slots(i).day | |
| ' Debug.Print "" | |
| Wend | |
| End Sub | |
| Private Sub sortSlotsByPoints() | |
| Dim highestDiff As Integer | |
| Dim tempslot As DutySlot | |
| Dim highestIndex As Integer | |
| ' Iterative variables | |
| Dim i As Integer, j As Integer | |
| i = 0 | |
| While (i < numSlots - 1) ' While (i < 52 - 1) | |
| j = i ' j = 0 | |
| highestIndex = 0 | |
| highestDiff = -1 | |
| ' This portion of code select the slot which has the highest number of points. | |
| While (j < numSlots) ' While (j < 52) | |
| If (slots(j).points > highestDiff) Then ' If (slots(0).points > highestDiff) Then | |
| highestDiff = slots(j).points | |
| highestIndex = j | |
| End If | |
| j = j + 1 | |
| Wend | |
| ' this is the original slots(0) | |
| Set tempslot = slots(i) | |
| ' Replace original slots(0) with new slots(highestIndex) | |
| Set slots(i) = slots(highestIndex) | |
| ' Place the tempSlot in the slots(highestIndex) | |
| Set slots(highestIndex) = tempslot | |
| i = i + 1 | |
| Wend | |
| End Sub | |
| Private Sub initVars() | |
| dutySlotsSheet = "Duty Slots" | |
| dutySlotsStartRow = 3 | |
| dateCol = 1 | |
| dayCol = 2 | |
| firstActualCol = 3 | |
| firstStbCol = 4 | |
| numDutyCols = 0 | |
| Dim i As Integer | |
| i = 3 | |
| While (Worksheets(dutySlotsSheet).Cells(2, i).Value <> "POINTS") | |
| numDutyCols = numDutyCols + 1 ' numDutyCols = 2 | |
| i = i + 2 | |
| Wend | |
| pointsCol = i ' pointsCol = 7 | |
| firstCheckCol = 3 | |
| lastCheckCol = 6 | |
| dutyTypeCell = "C1" ' Checks if its for Guard or Guard 2 IC | |
| monthCell = "D1" | |
| dutyHeaderRow = 2 | |
| dutyType = Worksheets(dutySlotsSheet).Range(dutyTypeCell).Value | |
| planningmonth = Worksheets(dutySlotsSheet).Range(monthCell).Value | |
| plannerSheet = "Guard Duty Planner" | |
| dutyGapCell = "M4" | |
| standbyGapCell = "M5" | |
| minDutyGap = Worksheets(plannerSheet).Range(dutyGapCell).Value | |
| minStbGap = Worksheets(plannerSheet).Range(standbyGapCell).Value | |
| End Sub | |
| Function countRows() | |
| Dim i As Integer | |
| i = dutySlotsStartRow | |
| While (Not IsEmpty(Worksheets(dutySlotsSheet).Cells(i, 1).Value)) | |
| i = i + 1 | |
| Wend | |
| countRows = i - dutySlotsStartRow | |
| ' The return value is 52 | |
| End Function | |
| Function getPlanningMonth() | |
| initVars | |
| getPlanningMonth = planningmonth | |
| End Function | |
| Function getDutyType() | |
| initVars | |
| getDutyType = Worksheets(dutySlotsSheet).Range(dutyTypeCell).Value | |
| End Function | |
| Function getPointsCol() | |
| getPointsCol = pointsCol | |
| End Function | |
| Function getColHeader(col As Integer) | |
| getColHeader = Worksheets(dutySlotsSheet).Cells(dutyHeaderRow, col).Value | |
| End Function | |
| Sub ClearAllCells() | |
| ' | |
| ' ClearAllCells Macro | |
| Range("C3:F92").Select | |
| Selection.ClearContents | |
| Selection.Interior.ColorIndex = 2 | |
| End Sub | |
Day : 1 slots : 3
Day : 1 slots : 8
Day : 1 slots : 9
Day : 1 slots : 12
Day : 9 slots : 4
Day : 10 slots : 5
Day : 10 slots : 6
Day : 10 slots : 7
Day : 14 slots : 0
Day : 14 slots : 1
Day : 15 slots : 10
Day : 18 slots : 11
Day : 21 slots : 2
Day : 24 slots : 13
Day : 24 slots : 14
Day : 24 slots : 15
Day : 24 slots : 16
Day : 25 slots : 17
Day : 25 slots : 18
Day : 26 slots : 19
Day : 30 slots : 20
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Need to validate slots else, it will loop again and again.