Employee Schedule Generator

R

rdbauer83

New Member
Joined
May 2, 2022
Messages
14
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
  5. 2013
Platform
  1. Windows
Ok just throwing it out there for all you experts as I am not one.

I want to be able to randomly generate a schedule for my employees.

Basics...Each employee works 4 days a week but not necessarily in a row and 1 of the 4 days must be a Sat or Sun but not both. Each day there are 2 different shift times. Each week I would like to run the generator to have the schedule created within given conditions of number of people that are needed for each day and shift. Also there are days that an employee is off for vacation so I would like the generator to not assign a shift for them on that day. Lastly, if an employee works shift time 2 they can't work shift time 1 the next day but must have at least one day between. BUT, if they work shift time 1 they CAN work shift time 2 the next day. Ok that enough conditions thrown at y'all :)

Book1
CDEFGHIJKL
1August-08-August-14
2
3MonTuesWedThurFriSatSun
4NAMESEMP ID8/88/98/108/118/128/138/14
5NAME 11111TIME 2TIME 2TIME 2TIME 2
6NAME 22222TIME 1TIME 1TIME 1TIME 1
7NAME 33333TIME 1TIME 2TIME 2TIME 2
8NAME 44444TIME 1TIME 1TIME 1TIME 1
9NAME 55555TIME 2OFFTIME 1TIME 2OFFTIME 1OFF
10NAME 66666TIME 2TIME 2TIME 1TIME 1
11NAME 77777TIME 2TIME 1TIME 1TIME 1
12NAME 88888TIME 1TIME 2TIME 2TIME 2
13NAME 99999TIME 1TIME 2TIME 1TIME 2
14NAME 101010TIME 1TIME 1TIME 1TIME 1
15NAME 110011TIME 2TIME 2TIME 2TIME 2
16NAME 121212TIME 1TIME 2TIME 2TIME 2
17NAME 131313TIME 1TIME 1TIME 1TIME 1
18NAME 141414TIME 1TIME 2TIME 2TIME 2
19NAME 151515TIME 2TIME 2TIME 2TIME 2
20NAME 161616TIME 2TIME 2TIME 2TIME 2
21NAME 171717TIME 2TIME 2TIME 2TIME 2
22NAME 181818TIME 2TIME 2TIME 2TIME 1
23NAME 191919TIME 2TIME 2TIME 2TIME 2
24NAME 202020TIME 1TIME 1TIME 2TIME 1
25
26CONDITIONS
27MonTuesWedThurFriSatSun
28TIME 16535536
29TIME 28776856
Sheet1
Cell Formulas
RangeFormula
F1F1=F4
J1J1=L4
G4:L4G4=F4+1
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
silly question, don't you have to know the shift of the preceding sunday (the time2's) for the next monday ?
 
Upvote 0
BSALV said:
silly question, don't you have to know the shift of the preceding sunday (the time2's) for the next monday ?
Click to expand...
Not a silly one. Yes and I am already looking at the previous week Sunday anyways. Also we have some people that are part time and won't work 4 shifts. BUT being able to solve this will save me about 3 hours because then all I will need to do is adjust the anomalies of the PT people and the ones that were a shift 2 on the previous Sunday.
 
Upvote 0
the previous Sunday-problem is solved when you give their numbers in column D
Schedule
 
Upvote 0
@BSALV You have already been told a number of times, you MUST post your solution to the board, not just a link to a file.
Please do so now.
 
Upvote 0
as demanded (but my macro isn't a real beauty 🧐
Shortcuts
CTRL+SHIFT+S for the recalulating the Schedule
CTRL+Shift+P for Printing

Updated version with extra comments, etc schedule
VBA Code: 
Sub test()
     Dim a(1 To 5) As Integer, W(1 To 7), aOff, aSchedule

     Application.ScreenUpdating = False
     t = Timer
     Set dict = CreateObject("scripting.dictionary")
     For i = 1 To WorksheetFunction.Power(3, 5)     'all the possible combinations for Mo-Fr 0=nothing, 1 and 2 = 3^5
          a(1) = a(1) + 1
          For j = 1 To UBound(a) - 1
               If a(j) > 2 Then a(j) = 0: a(j + 1) = a(j + 1) + 1 Else Exit For
          Next
          s = ""
          For j = 1 To UBound(a)
               s = s & a(j) & " "
          Next
          If Len(Replace(Replace(s, "0", ""), " ", "")) = 3 Then     'only those combinations with 3 shifts in those days
               For Each it In Array("1 0", "2 0", "0 1", "0 2")     'add another shift on Sa-So
                    If InStr(1, s & it, "2 1") = 0 Then dict(s & it) = vbEmpty     'add those shifts to the dictionary except for the "shift1 after shift2"
               Next
          End If
     Next
     d = dict.keys     'array with all allowed combinations

     With Range(Range("A5"), Range("A" & Rows.Count).End(xlUp))     'range with the names
          aOff = .Offset(2).Value     'column which detects if there are the "OFF"-days
          aSchedule = .Offset(, 3).Resize(, 8).Value     'array with data about the preceding sunday + the OFF-days
     End With

     With Range("AA5").Resize(100, 7)     'output range
          .ClearContents

          seq = WorksheetFunction.Sequence(1, UBound(aOff))     'array with sequence 1,2,3,.... as many as there are persons
          For i = UBound(seq) To 1 Step -1     '"managed" draw
               r = Application.Match(1, aOff, 0)     'check if there are still "OFF"-people
               b = IsNumeric(r)     'YES
               If b Then
                    r0 = r     'take that person
                    aOff(r, 1) = 0     'reset that element in that array
               Else
                    r0 = WorksheetFunction.RandBetween(1, i)     'else that random one of the remaining persons
               End If
               r1 = seq(r0): seq(r0) = seq(i)     'the index of that person and copy the index of the last remaining person in its position
               Delta = 1000000000#     'start with a high number
               s = "": k1 = 0     'reset those variables
               For j = 0 To UBound(d)     'loop through the possible combinations
                    If --aSchedule(r1, 1) <> 2 Or --Left(d(j), 1) <> 1 Then     'not a "Time2-Time1" after the previous sunday
                         For k = 1 To 7
                              k0 = k0 - (aSchedule(r1, k + 1) = "off" And Mid(d(j), k * 2 - 1, 1) = "0")     'count how many OFF-days compared to days with "0"
                         Next
                         If k0 > k1 Then s = "": k1 = k0     'look to maximise that count
                         If k0 = k1 Then s = s & "|" & d(j)     'collect all the combinasions with that maximized count
                    End If
               Next
               If b And s <> "" Then d1 = Split(Mid(s, 2), "|") Else d1 = d     'work further with those combinasions or take them all


               For j = 0 To UBound(d1)     'loop through those combinations
                    If --aSchedule(r1, 1) <> 2 Or --Left(d1(j), 1) <> 1 Then     'check for no "Time2-Time1" combination on previous Su-Mo
                         sp = Split(d1(j))     'split combination
                         For k = 0 To 6     'loop the 7 days
                              W(k + 1) = IIf(aSchedule(r1, k + 2) <> "off", sp(k), "OFF")     'array with those shifts except for the OFF-days
                         Next
                         .Cells(r1, 1).Resize(, 7).Value = W     'copy to the sheet
                         Delta0 = Range("AI2").Value - Range("AI1").Value     'difference between max and min number of persons per day
                         If Delta0 < Delta Then     'look to minimize that difference
                              Delta = Delta0     'new delta
                              s = d1(j)     'start with that combination
                         ElseIf Delta0 = Delta Then     'same delta
                              s = s & "|" & d1(j)     'collect all those combinations
                         End If
                    End If
               Next

               sp1 = Split(s, "|")     'split all combinations with same minimal delta
               r = WorksheetFunction.RandBetween(0, UBound(sp1))     'take a random combination
               sp = Split(sp1(r))     'split that combination
               For k = 0 To UBound(sp)     'all 7 days
                    W(k + 1) = IIf(aSchedule(r1, k + 2) <> "off", sp(k), "OFF")
               Next
               .Cells(r1, 1).Resize(, 7).Value = W     'copy to the sheet

          Next

          .Offset(, -1).Resize(UBound(aSchedule), 1).Value = Application.Index(aSchedule, 0, 1)     'copy the previous sunday to the Z-column

     End With
     P_Preview
End Sub
 
Upvote 0
BSALV said:
as demanded (but my macro isn't a real beauty 🧐
Shortcuts
CTRL+SHIFT+S for the recalulating the Schedule
CTRL+Shift+P for Printing

Updated version with extra comments, etc schedule
VBA Code: 
Sub test()
     Dim a(1 To 5) As Integer, W(1 To 7), aOff, aSchedule

     Application.ScreenUpdating = False
     t = Timer
     Set dict = CreateObject("scripting.dictionary")
     For i = 1 To WorksheetFunction.Power(3, 5)     'all the possible combinations for Mo-Fr 0=nothing, 1 and 2 = 3^5
          a(1) = a(1) + 1
          For j = 1 To UBound(a) - 1
               If a(j) > 2 Then a(j) = 0: a(j + 1) = a(j + 1) + 1 Else Exit For
          Next
          s = ""
          For j = 1 To UBound(a)
               s = s & a(j) & " "
          Next
          If Len(Replace(Replace(s, "0", ""), " ", "")) = 3 Then     'only those combinations with 3 shifts in those days
               For Each it In Array("1 0", "2 0", "0 1", "0 2")     'add another shift on Sa-So
                    If InStr(1, s & it, "2 1") = 0 Then dict(s & it) = vbEmpty     'add those shifts to the dictionary except for the "shift1 after shift2"
               Next
          End If
     Next
     d = dict.keys     'array with all allowed combinations

     With Range(Range("A5"), Range("A" & Rows.Count).End(xlUp))     'range with the names
          aOff = .Offset(2).Value     'column which detects if there are the "OFF"-days
          aSchedule = .Offset(, 3).Resize(, 8).Value     'array with data about the preceding sunday + the OFF-days
     End With

     With Range("AA5").Resize(100, 7)     'output range
          .ClearContents

          seq = WorksheetFunction.Sequence(1, UBound(aOff))     'array with sequence 1,2,3,.... as many as there are persons
          For i = UBound(seq) To 1 Step -1     '"managed" draw
               r = Application.Match(1, aOff, 0)     'check if there are still "OFF"-people
               b = IsNumeric(r)     'YES
               If b Then
                    r0 = r     'take that person
                    aOff(r, 1) = 0     'reset that element in that array
               Else
                    r0 = WorksheetFunction.RandBetween(1, i)     'else that random one of the remaining persons
               End If
               r1 = seq(r0): seq(r0) = seq(i)     'the index of that person and copy the index of the last remaining person in its position
               Delta = 1000000000#     'start with a high number
               s = "": k1 = 0     'reset those variables
               For j = 0 To UBound(d)     'loop through the possible combinations
                    If --aSchedule(r1, 1) <> 2 Or --Left(d(j), 1) <> 1 Then     'not a "Time2-Time1" after the previous sunday
                         For k = 1 To 7
                              k0 = k0 - (aSchedule(r1, k + 1) = "off" And Mid(d(j), k * 2 - 1, 1) = "0")     'count how many OFF-days compared to days with "0"
                         Next
                         If k0 > k1 Then s = "": k1 = k0     'look to maximise that count
                         If k0 = k1 Then s = s & "|" & d(j)     'collect all the combinasions with that maximized count
                    End If
               Next
               If b And s <> "" Then d1 = Split(Mid(s, 2), "|") Else d1 = d     'work further with those combinasions or take them all


               For j = 0 To UBound(d1)     'loop through those combinations
                    If --aSchedule(r1, 1) <> 2 Or --Left(d1(j), 1) <> 1 Then     'check for no "Time2-Time1" combination on previous Su-Mo
                         sp = Split(d1(j))     'split combination
                         For k = 0 To 6     'loop the 7 days
                              W(k + 1) = IIf(aSchedule(r1, k + 2) <> "off", sp(k), "OFF")     'array with those shifts except for the OFF-days
                         Next
                         .Cells(r1, 1).Resize(, 7).Value = W     'copy to the sheet
                         Delta0 = Range("AI2").Value - Range("AI1").Value     'difference between max and min number of persons per day
                         If Delta0 < Delta Then     'look to minimize that difference
                              Delta = Delta0     'new delta
                              s = d1(j)     'start with that combination
                         ElseIf Delta0 = Delta Then     'same delta
                              s = s & "|" & d1(j)     'collect all those combinations
                         End If
                    End If
               Next

               sp1 = Split(s, "|")     'split all combinations with same minimal delta
               r = WorksheetFunction.RandBetween(0, UBound(sp1))     'take a random combination
               sp = Split(sp1(r))     'split that combination
               For k = 0 To UBound(sp)     'all 7 days
                    W(k + 1) = IIf(aSchedule(r1, k + 2) <> "off", sp(k), "OFF")
               Next
               .Cells(r1, 1).Resize(, 7).Value = W     'copy to the sheet

          Next

          .Offset(, -1).Resize(UBound(aSchedule), 1).Value = Application.Index(aSchedule, 0, 1)     'copy the previous sunday to the Z-column

     End With
     P_Preview
End Sub
Click to expand...
It keeps coming up with a "Type Mismatch" error and only inputs a couple schedules for people. Also, in the example the number of people working by day/shift does not match the given conditions at the bottom of the example. These "conditions" are what will change on a weekly basis.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Automatic accrual calculations by day with accrual rate?
Replies
0
Views
240
Sunshine8790
S
alm395
  • Question
Coverage By Hour
Replies
3
Views
177
alm395
alm395
E
  • Question
How to generate shifts in excel
Replies
3
Views
433
elcafe31
E
F
  • Solved
Excel formula needed
5 6 7
Replies
66
Views
2K
KRice
K
R
  • Question
Auto Generate Timesheets Based Off Master Document
Replies
2
Views
374
RezLar
R

Forum statistics

Threads
1,214,922
Messages
6,122,281
Members
449,075
Latest member
staticfluids

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top