Randomized Task Rota

Validity12 · Oct 9th 2015

Hello,

I was wondering if anyone here would be able to assist me with creating a randomized task Rota? We have quite a few tasks and I find that it would waste half of my Monday morning assigning everybody these tasks per week, whilst also trying to eliminate people doing the same thing all the time! I found a thread on here that my work colleague and I have been manipulating to try and suit our needs, but I feel that this has gone a bit above our heads.

I am hoping that someone out there is able to help me to fix our Rota given the following criteria:
I would like for Column F to use the Names in the Help Desk Operatives table to randomly assign tasks to people, with the following restrictions in place

Any Tasks that in column E have Seniors in it, can only randomize names using 'names 1-4'
Any Tasks that in column E have ESI in it, can only randomize using 'names 8-9'
For anything else in Column E, (if a specific name is in there) that doesn't mean that person specifically has to do that job, these can all be randomized on Names 1-9 too

We are currently using column D to create stationary items in column F, if that could remain that would be great, as some tasks just have one owner and don't need to be randomized.

I have attached our workings so far, any help on this matter would be greatly received! Please feel free to manipulate the spreadsheet in any way. If the names and tasks could be added to over time as well that would be great, as this list is not exhaustive unfortunately!

I hope I'm not asking too much! I look forward to any responses I may receive.

Best regards,

Validity12 · Oct 12th 2015

Re: Randomized Task Rota

Hey everyone,

Just wanted to say I haven't made any progress on this as of yet, mainly because I suck at vba. Anybody else making any progress?

Thanks!

jindon · Oct 12th 2015

Re: Randomized Task Rota

Having read your instructions, hard to understand how you want it.
Do you want

1) Randomize col.F within Name 1- 4 where col.E has Senior
2) Randomize col.F within Name 8 - 9 where col.E has ESI
?
Third criteria is not clear to me.

Validity12 · Oct 12th 2015

Re: Randomized Task Rota

Hi Jindon,

Thank you very much for getting back to me, I was hoping it would be you as the initial code we used was yours! did you notice?

Here are the basic requirements, I changed names 8-9 to names 5-6 to make it easier (I hope) as they are constants within our team. Any other names will be temporary members of staff.
1)Randomize Col.F within Name 1-4 where col.E has Senior
2) Randomize Col.F within name 5-6 where Col.E has ESI
3) Randomioze Col.F with all names where Col.E has anything else.
4) If a cell in Col.D has a value, do not randomize corresponding cell in Col.F
5) Names and tasks are not exhaustive. They will be added to over time.

Does that makes sense? Thank you again for your response, it is much appreciated.

Best regards,

jindon · Oct 12th 2015

Re: Randomized Task Rota

See if this is how you wanted

Code

Option Explicit
Option Compare Text
Sub test()
    Dim a, i As Long, temp As String, e, s, flg As Boolean, dic As Object
    Const txt As String = "Others"
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Cells(1).CurrentRegion.Resize(, 6)
        a = .Value
        For i = 2 To UBound(a, 1)
            If a(i, 4) = "" Then
                temp = a(i, 5)
                Select Case temp
                    Case "Seniors"
                        If Trim$(Split(a(i, 6))(1)) Like "[1-4]" Then flg = True
                    Case "ESI"
                        If Trim$(Split(a(i, 6))(1)) Like "[56]" Then flg = True
                    Case Else: temp = txt: flg = True
                End Select
                If flg Then
                    If Not dic.exists(temp) Then
                        ReDim w(1 To 2)
                    Else
                        w = dic(temp)
                    End If
                    w(1) = w(1) & IIf(w(1) <> "", Chr(2), "") & i
                    w(2) = w(2) & IIf(w(2) <> "", Chr(2), "") & a(i, 6)
                    dic(temp) = w
                End If
            End If
            flg = False
        Next
        Randomize
        With CreateObject("System.Collections.SortedList")
            For Each e In dic
                For Each s In Split(dic(e)(1), Chr(2))
                    .Item(Rnd) = s
                Next
                For i = 0 To .Count - 1
                    a(.GetByIndex(i), 6) = Split(dic(e)(2), Chr(2))(i)
                Next
                .Clear
            Next
        End With
        .Value = a
    End With
End Sub

Display More

Validity12 · Oct 12th 2015

Re: Randomized Task Rota

Hi Jindon,

Thanks for this, its very close to what we want. Do you think its possible to pick up the names 8-9 in the table "Help Desk Operatives", Same for names 1-4?
So for instance, If Seniors in row E then pick a random name from H16-H19.
If ESI in Row E then pick a random name from H20-H21

My Colleague (who knows much more than me) said that we used your initial code (see thread in first post) which is based on an array? Is it possible to implement the same here,
using the Availability in the table 'Help desk Operatives' to NOT use a name if there is a 'no' in J16 onwards.

I know I'm asking a lot, so please tell me if your bored of me yet! We can work out another way. I've uploaded another example (with actual names) which may help make it a bit clearer.

Thanks again

jindon · Oct 13th 2015

Re: Randomized Task Rota

What do you mean by "very close"?
If the code doesn't do what you asked in your post #4, you should specify how it is not working completely, otherwise I think I am not capable to understand what you are asking.

Validity12 · Oct 19th 2015

Re: Randomized Task Rota

Hi,

Just thought you might like to know. We got it the way we wanted.

Here's the code and a template for anybody else to use:

Code

Sub test()
Dim a, i As Long, ii As Long, t As Long, answer As Integer
    
    answer = MsgBox("Are you sure you want to update the task assignments?", vbYesNo + vbQuestion, "Update")
  If answer = vbYes Then
   
     a = Range("G10").CurrentRegion.Value
    Randomize
    With CreateObject("Scripting.Dictionary")
        For ii = 2 To UBound(a, 2)
            Set .Item(a(1, ii)) = _
            CreateObject("System.Collections.SortedList")
                        For i = 2 To UBound(a, 1)
                If a(i, ii) = "yes" Then .Item(a(1, ii))(Rnd) = a(i, 1)
           Next
        Next
        
        
        a = Range("D1").CurrentRegion.Value
         'ii = 0
                For i = 2 To UBound(a, 1)
            
                     If .exists(a(i, 1)) Then
              
                t = 2


                Do While t <= UBound(a, 2)
              a(i, t) = .Item(a(i, 1)).GetByIndex(ii)
                           ii = ii + 1
                           t = t + 1
                ' MsgBox "i " & i & vbNewLine & "t " & t & vbNewLine & "ii " & ii '& vbNewLine & "a(i, t) " & a(i, t)
                
                    If ii >= .Item(a(i, 1)).Count Then ii = 0
                Loop
            End If
        Next
    End With
    
    Range("D1").CurrentRegion.Value = a
    
    
    'MsgBox "ESI"
    
        a = Range("G22").CurrentRegion.Value
    Randomize
    With CreateObject("Scripting.Dictionary")
        For ii = 2 To UBound(a, 2)
            Set .Item(a(1, ii)) = _
            CreateObject("System.Collections.SortedList")
                        For i = 2 To UBound(a, 1)
                If a(i, ii) = "yes" Then .Item(a(1, ii))(Rnd) = a(i, 1)
           Next
        Next
        
        
        a = Range("D1").CurrentRegion.Value
         ii = 0
                For i = 2 To UBound(a, 1)
            
                     If .exists(a(i, 1)) Then
              
                t = 2




                Do While t <= UBound(a, 2)
              a(i, t) = .Item(a(i, 1)).GetByIndex(ii)
                           ii = ii + 1
                           t = t + 1
                ' MsgBox "i " & i & vbNewLine & "t " & t & vbNewLine & "ii " & ii '& vbNewLine & "a(i, t) " & a(i, t)
                
                    If ii >= .Item(a(i, 1)).Count Then ii = 0
                Loop
            End If
        Next
    End With
    
    Range("D1").CurrentRegion.Value = a
    
    'MsgBox "ALL"
    
        a = Range("J10").CurrentRegion.Value
    Randomize
    With CreateObject("Scripting.Dictionary")
        For ii = 2 To UBound(a, 2)
            Set .Item(a(1, ii)) = _
            CreateObject("System.Collections.SortedList")
                        For i = 2 To UBound(a, 1)
                If a(i, ii) = "yes" Then .Item(a(1, ii))(Rnd) = a(i, 1)
           Next
        Next
        
        
        a = Range("D1").CurrentRegion.Value
         'ii = 0
                For i = 2 To UBound(a, 1)
            
                     If .exists(a(i, 1)) Then
              
                t = 2




                Do While t <= UBound(a, 2)
              a(i, t) = .Item(a(i, 1)).GetByIndex(ii)
                           ii = ii + 1
                           t = t + 1
                ' MsgBox "i " & i & vbNewLine & "t " & t & vbNewLine & "ii " & ii '& vbNewLine & "a(i, t) " & a(i, t)
                
                    If ii >= .Item(a(i, 1)).Count Then ii = 0
                Loop
            End If
        Next
    End With
    
    Range("D1").CurrentRegion.Value = a
      Else
    End If
End Sub

Display More

Jindon, Thank you for all your help, sorry I wasn't able to explain myself, it was hard to get what we wanted!

Best Regards,

Randomized Task Rota

Participate now!

Share