Robandemmy
Board Regular
- Joined
- Jul 16, 2018
- Messages
- 65
Hello,
I am trying to help a business unit a a factory I work at with their on call/call in list for covering occasional absences (if someone calls in sick, the shift supervisor uses this list to know who to call for coverage).
I have something that I borrowed from a sister factory but because we are a bit smaller, it's not working for us. It has tabs for each of the 4 crews and this macro to generates a list that calendar tabs use to lookup employee names:
So the file essentially looks at what crew is working, what the coverage crew is and assigns an employee from that list to be on call or stand by. With our schedule (Repeating 4 week schedule of days and nights , employees work 14 days and are off 14 days. The problem with the file is when a crew has 7 employees...the employees on that crew then become on call on the same day of the week everytime, where as shorter or heavier crews of 6 or 8 end up being more varied.
So my question becomes this...is there a way to add an element of randomness? Would still need the employees to be on call the same number of times but have a way to ensure that they are not on call the same day all of the time.
I know that's a lot, but I appreciate any help!
Thanks,
Rob
I am trying to help a business unit a a factory I work at with their on call/call in list for covering occasional absences (if someone calls in sick, the shift supervisor uses this list to know who to call for coverage).
I have something that I borrowed from a sister factory but because we are a bit smaller, it's not working for us. It has tabs for each of the 4 crews and this macro to generates a list that calendar tabs use to lookup employee names:
VBA Code:
Sub Construction()
'definition of the variables
Dim Crew As Long
Dim Crew1 As Long
Dim Crew2 As Long
Dim Crew3 As Long
Dim Crew4 As Long
Dim positionCrew1 As Long
Dim positionCrew2 As Long
Dim positionCrew3 As Long
Dim positionCrew4 As Long
Dim I As Long
Dim InputStartDate As String
Dim StartDate As Date
Dim StartLine As Long
Dim myTableArray As Range
Dim myVLookupResult As Long
Line0A:
InputStartDate = ""
'Ask at what date the update has to start to allow changes during the year
InputStartDate = InputBox("What date do you want to start building the call-in list?", "Please enter the date", "MM/DD/YYYY")
'If the user clicks on cancel then go to Line6
If StrPtr(InputStartDate) = 0 Then GoTo Line6
'Check if the input is a date
Do Until IsDate(InputStartDate) = True
MsgBox ("Please enter a date MM/DD/YYYY")
GoTo Line0A
Loop
StartDate = InputStartDate
'Check if the input is a valide date within the current year set up in the calendar file in column 10 line 1
If Year(StartDate) <> Sheets("calendar").Cells(1, 10) Then
MsgBox ("Please enter a date MM/DD/YYYY within the year: " & Sheets("calendar").Cells(1, 10))
GoTo Line0A
Else: GoTo Line0B
End If
Line0B:
'Set the #employees per crew
Crew1 = Sheets("Crew1").Cells(1, 3).Value
Crew2 = Sheets("Crew2").Cells(1, 3).Value
Crew3 = Sheets("Crew3").Cells(1, 3).Value
Crew4 = Sheets("Crew4").Cells(1, 3).Value
'Check if there is at least 1 employee for each crew
If Crew1 = 0 Then
MsgBox ("Please add employees in Crew 1")
GoTo Line6
End If
If Crew2 = 0 Then
MsgBox ("Please add employees in Crew 2")
GoTo Line6
End If
If Crew3 = 0 Then
MsgBox ("Please add employees in Crew 3")
GoTo Line6
End If
If Crew4 = 0 Then
MsgBox ("Please add employees in Crew 4")
GoTo Line6
End If
I = 0
positionCrew1 = 1
positionCrew2 = 1
positionCrew3 = 1
positionCrew4 = 1
'Define who is the next to be on call based on the person who was the last on call before the update (x in the crew list)
Do Until Sheets("crew1").Cells(positionCrew1 + 3, 4).Value = "x"
positionCrew1 = positionCrew1 + 1
Loop
positionCrew1 = positionCrew1 + 1
Do Until Sheets("crew2").Cells(positionCrew2 + 3, 4).Value = "x"
positionCrew2 = positionCrew2 + 1
Loop
positionCrew2 = positionCrew2 + 1
Do Until Sheets("crew3").Cells(positionCrew3 + 3, 4).Value = "x"
positionCrew3 = positionCrew3 + 1
Loop
positionCrew3 = positionCrew3 + 1
Do Until Sheets("crew4").Cells(positionCrew4 + 3, 4).Value = "x"
positionCrew4 = positionCrew4 + 1
Loop
positionCrew4 = positionCrew4 + 1
'Define where to start the update based on the date given by the user
StartLine = 2
Do Until Sheets("calendar").Cells(StartLine, 2) = StartDate 'as long as the date in the second column is different from the date given go to next line
StartLine = StartLine + 1
Loop
For I = StartLine To Range("A65536").End(xlUp).Row
If Sheets("calendar").Cells(I, 4).Value = 1 Then GoTo Line1 Else: 'if this is crew 1 then go to line1
If Sheets("calendar").Cells(I, 4).Value = 2 Then GoTo Line2 Else: 'if this is crew 2 then go to line2
If Sheets("calendar").Cells(I, 4).Value = 3 Then GoTo Line3 Else: GoTo Line4 'if this is crew 3 then go to line3 else go to line4
Line1:
If positionCrew1 > Crew1 Then positionCrew1 = 1 Else 'if we are at the end of the crew list then go back to the beginning
'if there is no name in this position go to line 1A else go to line 1B
If Sheets("crew1").Cells(positionCrew1 + 3, 2).Value = "" Then GoTo Line1A Else: GoTo Line1B
Line1A:
Do Until Sheets("crew1").Cells(positionCrew1 + 3, 2).Value <> "" 'As long as there is no name for this position go to next position
positionCrew1 = positionCrew1 + 1
Loop
Line1B:
Sheets("calendar").Cells(I, 5) = Sheets("crew1").Cells(positionCrew1 + 3, 2) 'Add the name of the crew member in the call in calendar for this day/shift
positionCrew1 = positionCrew1 + 1 'Go to the next crew team member in the list
GoTo Line5
Line2:
If positionCrew2 > Crew2 Then positionCrew2 = 1 Else
If Sheets("crew2").Cells(positionCrew2 + 3, 2).Value = "" Then GoTo Line2A Else: GoTo Line2B
Line2A:
Do Until Sheets("crew2").Cells(positionCrew2 + 3, 2).Value <> ""
positionCrew2 = positionCrew2 + 1
Loop
Line2B:
Sheets("calendar").Cells(I, 5) = Sheets("crew2").Cells(positionCrew2 + 3, 2)
positionCrew2 = positionCrew2 + 1
GoTo Line5
Line3:
If positionCrew3 > Crew3 Then positionCrew3 = 1 Else
If Sheets("crew3").Cells(positionCrew3 + 3, 2).Value = "" Then GoTo Line3A Else: GoTo Line3B
Line3A:
Do Until Sheets("crew3").Cells(positionCrew3 + 3, 2).Value <> ""
positionCrew3 = positionCrew3 + 1
Loop
Line3B:
Sheets("calendar").Cells(I, 5) = Sheets("crew3").Cells(positionCrew3 + 3, 2)
positionCrew3 = positionCrew3 + 1
GoTo Line5
Line4:
If positionCrew4 > Crew4 Then positionCrew4 = 1 Else
If Sheets("crew4").Cells(positionCrew4 + 3, 2).Value = "" Then GoTo Line4A Else: GoTo Line4B
Line4A:
Do Until Sheets("crew4").Cells(positionCrew4 + 3, 2).Value <> ""
positionCrew4 = positionCrew4 + 1
Loop
Line4B:
Sheets("calendar").Cells(I, 5) = Sheets("crew4").Cells(positionCrew4 + 3, 2)
positionCrew4 = positionCrew4 + 1
GoTo Line5
Line5:
Next I 'Go to next line of the calendar
Line6:
End Sub
So the file essentially looks at what crew is working, what the coverage crew is and assigns an employee from that list to be on call or stand by. With our schedule (Repeating 4 week schedule of days and nights , employees work 14 days and are off 14 days. The problem with the file is when a crew has 7 employees...the employees on that crew then become on call on the same day of the week everytime, where as shorter or heavier crews of 6 or 8 end up being more varied.
So my question becomes this...is there a way to add an element of randomness? Would still need the employees to be on call the same number of times but have a way to ensure that they are not on call the same day all of the time.
I know that's a lot, but I appreciate any help!
Thanks,
Rob
Last edited by a moderator: