Employee Schedule Generator

rdbauer83 · Aug 3, 2022

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

C

D

E

F

G

H

I

J

K

L

1

August-08

-

August-14

2

3

Mon

Tues

Wed

Thur

Fri

Sat

Sun

4

NAMES

EMP ID

8/8

5

NAME 1

1111

TIME 2

6

NAME 2

2222

TIME 1

7

NAME 3

3333

TIME 1

TIME 2

8

NAME 4

4444

TIME 1

9

NAME 5

5555

TIME 2

OFF

TIME 1

TIME 2

OFF

TIME 1

OFF

10

NAME 6

6666

TIME 2

TIME 1

11

NAME 7

7777

TIME 2

TIME 1

12

NAME 8

8888

TIME 1

TIME 2

13

NAME 9

9999

TIME 1

TIME 2

TIME 1

TIME 2

14

NAME 10

1010

TIME 1

15

NAME 11

0011

TIME 2

16

NAME 12

1212

TIME 1

TIME 2

17

NAME 13

1313

TIME 1

18

NAME 14

1414

TIME 1

TIME 2

19

NAME 15

1515

TIME 2

20

NAME 16

1616

TIME 2

21

NAME 17

1717

TIME 2

22

NAME 18

1818

TIME 2

TIME 1

23

NAME 19

1919

TIME 2

24

NAME 20

2020

TIME 1

TIME 2

TIME 1

25

26

CONDITIONS

27

Mon

Tues

Wed

Thur

Fri

Sat

Sun

28

TIME 1

6

5

3

5

3

6

29

TIME 2

8

7

6

8

5

6

Sheet1

Cell Formulas
Range	Formula
F1	F1	=F4
J1	J1	=L4
G4:L4	G4	=F4+1

BSALV · Aug 3, 2022

silly question, don't you have to know the shift of the preceding sunday (the time2's) for the next monday ?

BSALV · Aug 4, 2022

an trial with a macro (CTRL+SHIFT+S)
schedule

rdbauer83 · Aug 4, 2022

BSALV said:
silly question, don't you have to know the shift of the preceding sunday (the time2's) for the next monday ?

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.

BSALV · Aug 4, 2022

the previous Sunday-problem is solved when you give their numbers in column D
Schedule

Fluff · Aug 5, 2022

@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.

BSALV · Aug 5, 2022

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

rdbauer83 · Aug 7, 2022

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

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.

Employee Schedule Generator

rdbauer83

New Member

Excel Facts

BSALV

Banned user

BSALV

Banned user

rdbauer83

New Member

BSALV

Banned user

Fluff

MrExcel MVP, Moderator

BSALV

Banned user

rdbauer83

New Member

Similar threads

Forum statistics

Share this page

Employee Schedule Generator

New Member

Excel Facts

Banned user

Banned user

New Member

Banned user

MrExcel MVP, Moderator

Banned user

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock