Holiday Shift Bid

rbjexcpa · Sep 10th 2004

Just checking to see if there is a solution to this scenario:

Employees are bidding on 14 shifts over 7 holidays i.e. day shift and swing shift for 7 holidays. There are 20 shifts per holiday so total shifts available are 140. Each employee selects the shift they want to work with the number 1 and down to number 14 for the shift they least want to work. Each employee will have to work 2 out of the 7 holidays and are ranked by seniority.

Spreadsheet has been set up with each employee in order by seniority. Also, there is a page for each of their bids 1-14 with column headings A-N representing the 14 different shifts.

Problem: What kind of formula or macro is necessary to start at the top, put in the first person's number 1 and 2 choices in the right columns representing each of the shifts, then go on to the second person's row and enter their number 1 and two choices. Once 10 shifts per shift i.e. 10 A's are filled then no more A choices can be used, and so on until all shifts are filled.

Impossible? I'm sure that either there is a solution to this already or it can be dissected into enough pieces and pulled together in order to make it work.

Thanks in advance for all the wizard minds out there,

Rod

**Batman** · Sep 10th 2004

Hi rbjexcpa,

Check out the code below. I have created a workbook with 2 worksheets - Preferences for the employee selections and Rota for the results.

Each sheet has 38 rows for employees (column A, rows 3:40) and 14 columns(B:O) for shifts. Column P has formulae to check that each employee has selected the numbers 1-14 (in any order)
=SUM(B3:O3)=105 (in P3, filled down)

and cell P2 has an array formula (entered with Shift/Ctrl/Enter) to check that all of the employees check out OK
=(P3:P40=TRUE)

Code

Sub CreateShiftRota()
     Dim Preferences as Range, rngRota as Range
     Dim aintShiftTotals(1 To 14) as Integer
     Dim emp as Integer, shift as Integer
     Dim intPref as Integer, intAlloc as Integer


     Application.ScreenUpdating = False
     
     If Not Worksheets("Preferences").Range("P2").Value = True Then
          MsgBox "Employee shift selections are incomplete."
          End
     End If


     Set rngPreferences = Worksheets("Preferences").Range("B3:P40")
     Set rngRota = Worksheets("Rota").Range("B3:P40")


     For emp = 1 to 38
          intPref = 1
          intAlloc = 0
          shift = 1
          Do Until intAlloc = 2
               Do Until rngPreferences(emp, shift) = intPref
                    shift = shift + 1
               Loop


               If aintShiftTotals(shift) < 10 Then
                    rngRota(emp, shift) = intPref
                    aintShiftTotals(shift) = aintShiftTotals(shift) + 1
                    intAlloc = intAlloc + 1
                    intPref = intPref + 1
               End If
               shift = 1
               intPref = intPref + 1
          Loop
     Next emp


     Application.ScreenUpdating = True


End Sub

Display More

The result should be that each employee's top 2 available preferences are entered into the Rota worksheet.

Hope this helps & let me know if you need any explanation of the logic.

Regards,
Batman.

rbjexcpa · Sep 10th 2004

Thanks for the quick response!

I have setup the spreadsheet as outlined in your instructions and put in 38 employees and put their preferences in order to test like this:

1 2 3 4 5 6 7 8 9 10 11 12 13 14
14 13 12 11 10 9 8 7 6 5 4 3 2 1

and so on.

The results come out like this:

1 3
3 1

and so on down to when 10 of those selections are filled, then it has
2 4
4 2

for the next 10 selections.

The question is this.. if the list is in order by seniority.. the first persons results should be:
12
and the second persons should be:
21

Does that make sense? Let me know if there is a tweak I need to make. Otherwise this seems to work great.

Thanks!

Rod

**Batman** · Sep 11th 2004

Holiday shift bids

Hi Rod,

A few basic mistakes - the biggest of which was to develop and test this very late on a Friday afternoon!

I have increased the number of employees to 200 (but this can be any number, provided that there are no empty rows) and block copied the preferences and formulas to fill the new range.

1) Add a new declaration for a number of employees:
Dim intLastEmployee as Integer

2) Find the last employee record:
intLastEmployee = Worksheets("Preferences").Range("A3"). _
End(xlDown).Row 'A3 is my first employee record

3) Change the set commands to reflect the variable number of records:
Set rngPreferences = Worksheets("Preferences"). _
Range("A3:P" & intLastEmployee)
Set rngRota = Worksheets("Rota").Range("A3:P" & intLastEmployee)

4) Change the For/Next loop for the variable number of employees:
For emp = 1 To (intLastEmployee - 2) ' assumes 2 header rows

5) Change the first Do command to:
Do Until intAlloc = 2 or intPref > 14
This is necessary as you may find that towards the end of the rota allocation, only one of your employees' selections is available (e.g. if you use up all 10 shifts for numbers 1-13 leaving only 14 to allocate).

6) Delete the first of the 2 commands (within the If/End If block):
intPref = intPref + 1
This was what was causing the preferences to be allocated 1,3 instead of 1,2 etc.

This now seems to work for me, but let me know if you have any questions.

I have taken a few shortcuts in hard coding the number of preferences, shifts available to each person and people on each shift, so if you want to re-use this regularly there are a number of tweaks to make these numbers variable.

Regards,
Batman.

rbjexcpa · Sep 11th 2004

Hey, I appreciate your efforts on this!

I made the edits and it appears that I must be putting them in the wrong places as I end up with a Compile Error - Sub or Function not defined on

Do Until rngPreferences(emp, shift) = intPref

If you could send me the edited code I'll put that in and see where I'm messing it up. Also, your first version is actually what we want as the employees second choice is not always available by the time you process everyone's first choices. So, I won't need the last modification.

Thanks!

Rod

**Batman** · Sep 12th 2004

Holiday Shift Bid

Hi Rod,

Just spotted a typo in the declarations (Dim rngPreferences ...) which may be affecting your program. Anyhow, the full (hopefully correct) version is below:

Code

Option Explicit


Sub CreateShiftRota()
    Dim rngPreferences as Range, rngRota as Range
    Dim aintShiftTotals(1 To 14) as Integer
    Dim emp as Integer, shift as Integer
    Dim intPref as Integer, intAlloc as Integer
    Dim intLastEmployee as Integer
    Dim intNumShifts as Integer


    Application.ScreenUpdating = False


    ' Check it's OK to start the calculations
    If Not Worksheets("Preferences").Range("P2").Value = True Then
        MsgBox "Employee shift selections are incomplete."
        End
    End If


    ' Find the last employee and define the ranges to work with
    intLastEmployee = Worksheets("Preferences").Range("A3"). _
        End(xlDown).Row
    Set rngPreferences = Worksheets("Preferences"). _
        Range("B3:P" & intLastEmployee)
    Set rngRota = Worksheets("Rota").Range("B3:P" & intLastEmployee)


    ' Loop through the employees in the table
    For emp = 1 to (intLastEmployee - 2)


        ' Initialise counters for the employee
        intPref = 1
        intAlloc = 0
        shift = 1
        
        ' Check the employee until 2 shifts allocated or 
        ' all 14 preferences checked
        Do  Until intAlloc = 2 or intPref > 14


            ' Find the current preference for the employee in his record
            Do Until rngPreferences(emp, shift) = intPref
                shift = shift + 1
            Loop


            ' If the count of shifts allocated for the preference is less than 10
            ' output the preference number and increment the counters
            If aintShiftTotals(shift) < 10 Then
                rngRota(emp, shift) = intPref
                aintShiftTotals(shift) = aintShiftTotals(shift) + 1
                intAlloc = intAlloc + 1
                intNumShifts = intNumShifts + 1
            End If


            ' Increment the preference number and prepare to start searching
            ' for it from the start of the employee record
            shift = 1
            intPref = intPref + 1
        Loop


        ' If all 140 shifts have been allocated, jump out of the process
        If intNumShifts = 140 Then Exit For


    Next emp


    Application.ScreenUpdating = True


End Sub

Display More

You will need to use the latest version, as the first one produced the wrong results (1,3 instead of 1,2) and also errored when it had checked all 14 preferences for an employee and hadn't been able to allocate him(/her) to 2 shifts.

I hope this works for you, but let me know if you still have problems.

Regards,
Dave.

Excelpower · Sep 12th 2004

Hi everyone,

I have tried to reproduce this to see how it will work because I really like to see how this works.

My problem is that I am not getting any information on the Rota page, not sure why and I am also getting false in the P2 array formula cell and all of the rows add up to 105 and I think I should be getting a true in this cell, Not sure why.

I have attache the sample that I am trying to get to work using the corrected code.

Any help with what I am doing wrong will be helpful.

Excelpower
EP

**Batman** · Sep 12th 2004

Hi Excelpower,

The reason you are seeing False in cell P2 is that the formulae in cells P3:P40 should be:

=Sum(B3:O3)=105 (filled down)

This formula should test whether the sum of the row = 105 and should give a value of True or False, not simply the sum of the row. The array formula in cell P2, which you have entered correctly, is checking whether all the values in cells P3:P40 are =True.

You can either change the formulae in the individual rows of column P as suggested, or change the array formula to:
=(P3:P40=105) (again entered with Shift/Ctrl/Enter to give an array formula)

The first step of the program is checking whether the value in Cell P2 =True; if not it is exiting the program without doing anything. This is why you have no values in the Rota worksheet.

If you are using an example of 38 employees, which I did in my first reply to the thread, please note the latest version of the program which contains fixes to a few earlier errors. You may also need to use 70 or more employees to test out that the program allocates all 140 available shifts.

Hope you find this of use.

Regards,
Batman.

Excelpower · Sep 12th 2004

Thanks Batman, I change the formula and it works great.

Again thanks for the clearing this up for me.

EP

rbjexcpa · Sep 13th 2004

Also my regards to Batman for this highly useful code. I have set everything up and tested it several times with 58 employees and it seems to work slick. The only thing I can't seem to change and get to work is the Array Formula. It worked the first time and I can edit it, but it always shows TRUE even when the sheet is not filled out all the way. I have since changed it to =P3:P60=105 and it seems to be working (since it is currently set to FALSE since the bids are not yet all in. Since this is just a check to ensure that the sheet is filled in for a complete shift bid it is a minor problem at this point.

We have had one other complication come up with the shift bid though we will probably have to manually adjust for it - that is that people can select in numerical order two shifts on the same day which is impossible for them to work. Outside of the manual adjustments i.e. if 1 and 2 are for both day and swing shifts on the same day, changing the 2 to a 3 on the bid will probably be enough to ensure the results we need. Unless of course, there is a mathematical solution to check each day and only take one bid if the bid numbers are in sequence.

I would upload the file but it is now 408K.

Thanks again! You are the man!

Rod

**Batman** · Sep 13th 2004

Hi Rod, and thanks for the kind comments.

There were always likely to be a few complications with this; the reason for the formulae in the worksheet and the shortcuts in the program was to make the size of the code manageable and to be able to give you a reply within a reasonable time.

Not only is it currently possible for an employee to select and be given 2 shifts on the same day, but they could also be given 2 shifts on the same day if their earlier preferences are not available. Also, I assume that it may be possible for people to be unavailable on certain days (e.g. they are on approved holiday leave, etc.), so you may want to allow them to be able to enter, for example, NA.

I will try to have a look at a few of these changes later on today.

Regards,
Batman.

**Batman** · Sep 13th 2004

Updated for new functionality

Rod,

The code below should allow your employees to enter NA for any shift for which they are not available. It will also make sure there are no blanks in their data, check that all values from 1 to (14 - the number of NAs) are entered, and that they do not work 2 shifts on the same day, either through their selection or by earlier preferences not being available. You should now be able to remove the formulae in the spreadsheet.

To make the code work, in the Rota worksheet you need to enter in cells B1:O1 an indicator that the shift belongs to the same day, e.g. B1="Day1", C1="Day1", D1="Day2", E1="Day2", etc. It doesn't matter what the text is, as long as the 2 values for the same day are the same and are next to each other.

Code

Option Explicit


Dim intLastEmployee as Integer, rngPreferences as Range
Dim rngRota as Range, rngShifts as Range


Sub CreateShiftRota()
    Dim emp as Integer, aintShiftTotals(1 to 14) as Integer
    Dim shift as Integer, intPref as Integer, intAlloc as Integer
    Dim intNumShifts as Integer, boolOKToWork as Boolean


    Application.ScreenUpdating = False


    intLastEmployee = Worksheets("Preferences").Range("A3"). _
        End(xlDown).Row
    Set rngPreferences = Worksheets("Preferences"). _
        Range("B3:O" & intLastEmployee)
    Set rngRota = Worksheets("Rota").Range("B3:O" & intLastEmployee)
    Set rngShifts = Worksheets("Rota").Range("B1:O1")


    rngRota.ClearContents
    For emp = 1 to (intLastEmployee - 2)
        Call CheckEmployeeData(emp)
        intPref = 1
        intAlloc = 0
        shift = 1
        Do Until intAlloc = 2 or intPref > 14
            shift = WorksheetFunction.Match(intPref, _
                      Range(rngPreferences(emp,1), rngPreferences(emp, 14)), 0)
            boolOKToWork = CheckShift(emp, shift)
            If aintShiftTotals(shift) < 10 and boolOKToWork then
                rngRota(emp, shift) = intPref
                aintShiftTotals(shift) = aintShiftTotals(shift) + 1
                intAlloc = intAlloc + 1
                intNumShifts = intNumShifts + 1
            End If
            intPref = intPref + 1
        Loop
        If intNumShifts = 140 Then Exit For
    Next emp
    Application.ScreenUpdating = True


End Sub


Private Sub CheckEmployeeData(ByRef emp)


    Dim sel as Integer, col as Integer, intCountNA as Integer
    Dim rngEmpTest as Range


    On Error Resume Next
    Set rngEmpTest = Range(rngPreferences(emp, 1), _
        rngPreferences(emp, 14)).SpecialCells(xlCellTypeBlanks)
    On Error Goto 0     ' last character is zero


    If Not rngEmpTest is Nothing Then
        MsgBox "Invalid blank cells in employee " & emp
        End
    End If


    intCountNA = WorksheetFunction.CountIf _
        (Range(rngPreferences(emp, 1), rngPreferences(emp, 14)), "NA")
    On Error Goto InvalidEmployee
    For sel = 1 To (14 - intCountNA)
        col = Range(rngPreferences(emp, 1), rngPreferences(emp, 14)).Find _
               (What:=sel, After:=rngPreferences(emp, 1), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False)
    Next sel
    On Error Goto 0
    Exit Sub


InvalidEmployee:
    MsgBox "Incomplete selections for employee " & emp
    End


End Sub


Private Function CheckShift(ByRef emp, ByRef shift) As Boolean
    Dim intSameDay as Integer


    Select Case shift
        Case 1:   intSameDay = 2
        Case 14:  intSameDay = 13
        Case Else
            If rngShifts(1, shift + 1) = rngShifts(1, shift) Then
                intSameDay = shift + 1
            Else
                intSameDay = shift - 1
            End If
    End Select


    If Len(rngRota(emp, intSameDay)) > 0 Then _
        CheckShift = False Else CheckShift = True


End Function

Display More

I have changed the code in quite a few places, so you would be advised to copy and paste the complete text. I have carried out quite a few tests and it seems to work OK for me, but as always let me know if you have any problems.

Regards,
Batman.

rbjexcpa · Sep 15th 2004

This worksheet is incredibly handy and can be used for a variety of shift bids with different numbers of shifts, employees, and blocking the award of both a day and swing shift for the same day. If we could add one more variable that comes up frequently that would be having the ability to input a variable number of shifts available per day. In this example 10 was the maximum used for any day. What if in fact, the limits were in order:

Day 1 - 17
Swing 1 - 6
Day 2 - 15
Swing 2 - 8
Day 3 - 13
Swing 3 - 7
Day 4 - 5
Swing 4 - 5
Day 5 - 6
Swing 5 - 10
Day 6 - 15
Swing 6 - 5
Day 7 - 6
Swing 7 - 7

Is this too much complexity or simply the definition of two variables per days bid on?

Thanks in advance!

Rod

**Batman** · Sep 15th 2004

Rod,

The difficulty of varying the number of shifts available per day depends on whether you want one total per day or, more easily, one total per shift. I would have thought that the latter would be more sensible anyway, as otherwise you might end up with 17 people on the first shift of the day and none on the second.

As I don't work in an environment where shifts are common, could I get you to clarify the term "swing shift" and how the numbers per day (e.g. Swing 1-6 on Day 1) would be used? Should these numbers also be allocated on a shift basis, or can they only be done per day?

Regards,
Batman.

rbjexcpa · Sep 15th 2004

Swing shift is also known as second shift i.e. Day shift would come in typically from 8a-5p, Second shift from 5p to 2a, and Third shift (Graves) from 11p to 8a. The start and end times for each shift vary widely but that is not important just the allocation of workers to each shift.

As for the numbers given, continuing with this example there are 7 holidays, and we have tied them all together with two shifts per day using Day 1, Day 2 etc in sequence so that if an employee selected a day shift and a second shift on the same day it would go on to their next pick and not select both shifts.

So Swing 1 - 6 indicates that 6 people are needed for the swing (second) shift on Day 1.

So to summarize what we need to cap is instead of 10 per shift as we have it currently, we need one total per shift to match up with the 14 choices that can be bid on.

Let me know if that was more confusing or if that makes sense. You mentioned that doing it per shift would be easiest and makes the most sense and that is correct.

However to be sure... the shift requirements vary on each "shift" i.e. in order from shift #1 to #14

17, 6, 15, 8, 13, 7, 5, 5, 6, 10, 15, 5, 6 & 7

Thanks!

Rod

**Batman** · Sep 15th 2004

Rod,

No problem. The changes are straightforward, but will take me a while to code and test, and it's time to hit the road for home. I'll post the changes tomorrow.

Regards,
Batman.

**Batman** · Sep 16th 2004

Changes for variable numbers per shift

Hi Rod,

The changes you need to make are:

1) In cells C2:O2 of the Preferences sheet, enter the values you want for each shift. Apologies if this overwrites a heading; we can overcome this later if necessary.

2) Just below Option Explicit, insert:
Dim rngAvailable as Range, intMaxShifts as Integer

3) Below 'Set rngShifts ...' enter
Set rngAvailable = Worksheets("Preferences").Range("B2:O2")

4) Below 'rngRota.ClearContents' enter
intMaxShifts = WorksheetFunction.Sum _
(Range(rngAvailable(1, 1), rngAvailable(1, 14)))

5) Replace the single line 'If aintShiftTotals(shift) < ...' with
If aintShiftTotals(shift) < rngAvailable(1, shift) and boolOKToWork Then

6) Replace the line 'If intNumShifts = 140 ...' with
If intNumShifts = intMaxShifts Then Exit For

This should allow you to specify any number you like for each shift.

I suspect this thread has now gone beyond being of general interest to the forum, so if you get any further problems, or would like any more changes, it may be better if you send me a private e-mail.

Regards,
Batman.

eaalbriton · Oct 29th 2014

Re: Holiday Shift Bid

Batman, I just want to let you know that YOU ROCK!!!! I've been racking my brain over a similar scenario for a few days now. After reviewing your post for a few minutes and making slight modifications for my scenario, I was able to get this to work.

**Batman** · Oct 29th 2014

Re: Holiday Shift Bid

Hi eaalbriton,

Welcome to the Ozgrid forum.

Glad to know that the forum is proving to be of use, even after 10 years!

bvanscoyo678 · Nov 9th 2015

Re: Holiday Shift Bid

Batman,

Excellent thread! (even if > 10 years old) I was just looking at somehow change a manual processes of picking vacations (pencil and paper) for our fire department.

This will provide me a very good starting place with the loops and counters.

Thanks!

Holiday Shift Bid

Participate now!

Share

Users Viewing This Thread