-2

Background: I have a table with rows of Staff IDs and columns of shifts (two a day: AM and PM). Staff indicate whether they can attend each shift. I then run a module that generates lists of all IDs who can attend each shift.

Question: Is there a module that can take that list of potential attendees for each shift and generate four random IDs for each AM shift and three random IDs for each PM shift?

The PM shift should not have the same IDs as the AM shift for each day.

Image 1: enter link description here

Image 2: enter link description here

DesperateBureaucrat
  • 1
  • I'm a complete beginner to VBA, heard about it last week have been watching tutorials since. I'm trying to make this for my job. My predecessor assigned the shifts from hand based on that initial table and I think this is a better way. On this last step I've hit the limits of my abilities. I tried using a "For each x in range ("C26:C29").Cells Do:" and then Randomize from the list, but I couldn't get the coordinates of the Randomize to line up with the list (all that stuff with 10-1+1). Does that make sense? – DesperateBureaucrat Aug 18 '16 at 12:20
  • read how to generate random numbers in VBA, and how to use arrays (which you can set from a range in a sheet), then you'll use your random as an index in said array, a tip is also to keep a check of the random ones used and check that first. – Nathan_Sav Aug 18 '16 at 12:22
  • But I'm not trying to generate random numbers, I'm trying to randomize a sample of non-numeric datapoints – DesperateBureaucrat Aug 18 '16 at 12:23
  • Exactly my point, look at arrays, you'll use the number as an index,, i.e. array(1)="Shift 1", array(2)="Shitf2" or array(1)="what ever you like" array(2)="something else", then I want to pick a random one, so what do I need? "I then run a module that generates lists of all IDs who can attend each shift." what type of list is this, this would be your array. – Nathan_Sav Aug 18 '16 at 12:27
  • Can I ask a more specific question then? I found this module for doing that - I think. Is there a way to make it run on my generated list of IDs instead of the table itself? Sub Randomer() For Each x In Range("C16:C19").Cells Randomize chosen_person = Int((10 - 1 + 1) * Rnd + 1) x.Value = Cells(2 + chosen_person, 2).Value Next End Sub – DesperateBureaucrat Aug 18 '16 at 12:34

1 Answers1

0

This will do it - It's flexible on the number of employees available (can be 10, can be 50!) but it does assume 3 things:

  1. The list of employees starts on row 3 with no blanks in this list
  2. The Monday - Friday column C to column L
  3. The 1st row will indicate whether it's an AM or PM shift

Option Explicit

Sub Work_timetables()

Dim c As Integer, R As Long, iEmployees As Long, ID As String, iField As Integer, bAM As Boolean, lRandomNumber As Long, iNumbersNeeded As Integer, iPicked As Integer

Application.ScreenUpdating = False

c = 3
R = 2
iField = 1
iEmployees = Range("B3:B" & Range("B3").End(xlDown).Row).Rows.Count

Do Until c > 12
    Range("C2:L" & iEmployees + 2).AutoFilter Field:=iField, Criteria1:="Yes"
    Range("B3:B" & Range("B3").End(xlDown).Row).Copy
    Cells(iEmployees + 4, c).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("C2:L" & iEmployees).AutoFilter
    c = c + 1
    iField = iField + 1
Loop

c = 3
Start:
Do Until c > 12
    If c Mod 2 = 0 Then
        bAM = False
        iNumbersNeeded = 3
    End If
    If Not c Mod 2 = 0 Then
        bAM = True
        iNumbersNeeded = 4
    End If
    If (Cells(1048563, c).End(xlUp).Row - (iEmployees + 3)) < iNumbersNeeded Then
        MsgBox "There isn't enough emplooyees available for the " & Cells(2, c).Value & " (" & Cells(1, c).Value & ") shift" & vbNewLine & vbNewLine & "Moving to next shift", vbOKOnly, "Short staffed!"
        c = c + 1
        GoTo Start
    End If
    Do Until iPicked = iNumbersNeeded
goLoop:
        lRandomNumber = WorksheetFunction.RandBetween(iEmployees + 4, Cells(iEmployees + 4, c).End(xlDown).Row)
        If Trim(Range("B" & lRandomNumber).Value) = "" Then
            Range("B" & lRandomNumber).Value = "Picked"
            Cells(Range("C" & iEmployees + 4).CurrentRegion.Rows.Count + iEmployees + 6 + iPicked, c).Value = Cells(lRandomNumber, c)
            iPicked = iPicked + 1
            Else
                GoTo goLoop
        End If
    Loop
    Range("B" & iEmployees + 4 & ":B" & Range("C" & iEmployees + 4).CurrentRegion.Rows.Count + iEmployees + 4).ClearContents
    c = c + 1
    iPicked = 0
Loop

Application.ScreenUpdating = True

End Sub

enter image description here

Jeremy
  • 1,341
  • 2
  • 10
  • 26
  • I get error A004. Would you mind taking a screenshot to show the formatting of the table when you run the module? The error is on the line " Range("C2:L" & iEmployees).AutoFilter" – DesperateBureaucrat Aug 18 '16 at 18:45
  • What version of excel are you using? Mine is fine fine.. I've put the screenshot on my original answer..either way, replace that line with `ActiveSheet.AutoFilterMode = False` and that should do it – Jeremy Aug 19 '16 at 10:03
  • It works, thank you! Quick follow up question: will the PM shifts not assign the same IDs as the AM shifts if there are three IDs available? – DesperateBureaucrat Aug 20 '16 at 12:29
  • No, it's randomly assigned based on who says they're available for the PM shift - Would you prefer it to prioritize the AM staff for the PM shift and then assign any "left-over" slots? – Jeremy Aug 22 '16 at 08:37
  • The staff on the PM shift should not be the same staff on the AM shift for a given day. Would it be possible to eliminate the AM staff IDs from consideration for that day's PM shift? – DesperateBureaucrat Aug 22 '16 at 14:57
  • Ok.. but what if, after eliminating the AM staff from the PM selection, you don't have 3 people left? will you then have them included? – Jeremy Aug 22 '16 at 15:14
  • I actually have about 40 staff, so I'm not too concerned about that happening. But let's say yes, in that event AM shift does get included. – DesperateBureaucrat Aug 23 '16 at 19:15