Random Allocation on a WorkFlow

[Abgar]

Hi all,
This may sound silly (and maybe i'm just underthinking it), but i have a spreadsheet which is used as a Workflow for my team. Each row is an item, and i need to assign each item to one of the staff working on the workflow (currently 3 staff, but I see this increasing soon).
The workflow has approximately 500 rows of data at any time, but everyday there are new rows added (new tasks), and some rows removed (tasks completed).
There is a macro that imports all the information and formats etc to the new rows.

Essentially, what i'd like to do is to add to the macro (or create a new one) that will find any rows without a value in Column X (being what column i allocate the staff member in), and then populate a random staff members' name, while keeping roughly even distribution of rows (at least in the new rows on any given day).

I've had a look at the randbetween and choose functions, but every time a cell is updated, the formula resets, and a new outcome is derived.
Essentially, i'd like it to run once, and permanantly allocate that 1 task to 1 staff member, and not change.

I can see it being a very simple macro to do so, but i've been out of the macro realm for too long, and my brain hurts trying to come up with the solution. Is anyone able to assist me please?

Cheers

 

[BSALV]

Abgar.xlsb
the new jobs 'll be distributed random to the staffmembers in cycles, so everybody gets a 1st job and as soon as they all got a first job, then they get a 2nd. If that isn't random enough or if the macro also has to look to the already assigned number of jobs before the macro-start, that can be done.

Sub Assign()
     NF = "00.00000000000"     'numberformat
     Set sca = CreateObject("system.collections.arraylist")     'sorted array

     stf = Sheets("Blad1").ListObjects("TBL_Staff").DataBodyRange.Value     'all your staffmembers
     For i = 1 To UBound(stf)
          sca.Add Format(Rnd, NF) & "|" & stf(i, 1)     'add them to the SCA with a random value
     Next

     Set cstaff = Sheets("blad1").ListObjects("TBL_Workflow").ListColumns("Staff").DataBodyRange     'all the jobs
     arr = cstaff.Value     'read them to an array
     For i = 1 To UBound(arr)     'loop through that array
          DoEvents
          If Len(arr(i, 1)) = 0 Then     'jog isn't assigned yet
               sca.Sort     'sort that array
               a = sca.toarray
               sp = Split(a(0), "|")     'split smallest element into parts
               arr(i, 1) = sp(1)     'assigned staffmember
               sca.Remove a(0)     'remove that elemnt from the SCA
               sca.Add Format(Int(sp(0)) + 1 + Rnd, NF) & "|" & sp(1)   're-enter it with the integer part +1 and a random decimal part
          End If
     Next

     cstaff.Value = arr     'write array back to range
End Sub

 

[Abgar]

Hi Bsalv,

Thanks for your help here - unfortunately it did not work, however. When attempting to run the VBA code via macro, i get a "Run-time error '-2146232576 (80131700)': Automation Error".
On de-bug, it highlights this line of the macro coding:
Set sca = CreateObject("system.collections.arraylist") 'sorted array

Would you be able to help fix or explain please?

I've never really used or understood arrays, so i can't really understand what is actually happening in this code....
However, if it all possible to request 2 changes....
1 - The sample spreadsheet you created is in a table (which the macro seems to be reading) - the data in my active spreadsheet is not in a defined table. I can't put it into a table either. Can this code work without the data being in a defined table?
2 - The list of staff names, is that able to put onto a separate worksheet in the spreadsheet?

Thanks so much again for your help.

 

[BSALV]

here a good guide for system.collections.arraylist VBA ArrayList - A Complete Guide - Excel Macro Mastery and in section 4.3 how you can solve your problem. I tried to link directly to that one, but ...

 

[BSALV]

abgar.xlsb
Now, if SCA isn't working, then the oldfashioned way in the sheet

Const iKolStaff = 24     '----> column 24 is the column to assign the staff
Const ColAux = "AE"     '---> use this column as auxiliary for sorting in case SCA isn't working

Sub Assign()

     NF = "000.00000000000"     'numberformat
     On Error Resume Next
     Set sca = CreateObject("system.collections.arraylist")     'sorted array
     On Error GoTo 0
     b = (VarType(sca) = vbEmpty)   'error detected with SCA = don't use it here

     With Sheets("MyStaff")     'staff in another sheet with header "staff" in D5
          r = .Range("D" & Rows.Count).End(xlUp).Row
          If r <= 5 Then MsgBox "no staff", vbCritical: Exit Sub
          Set c1 = .Range("D5").Resize(r - 5)     'this is the range with your staffmemeber
          a = c1.Value
     End With
     With Sheets("Data")
          If b Then .Columns(ColAux).ClearContents
          For i = 2 To UBound(a)
               If b Then     'SCA not working
                    .Range(ColAux & i - 1).Value = Format(Rnd, NF) & "|" & a(i, 1)     'write values to sheet
               Else
                    sca.Add Format([Rnd], NF) & "|" & a(i, 1)    'add them to the SCA with a random value
               End If
          Next

          Set c2 = .Range("A1").CurrentRegion    'the range with all your data
          Set c3 = c2.Offset(1, iKolStaff - 1).Resize(c2.Rows.Count - 1, 1)    'only interested in the column where you assign the staffmembers without the header
          arr = c3.Value     'read them to an 2D-array
          For i = 1 To UBound(arr)     'loop through that array
               DoEvents
               If Len(arr(i, 1)) = 0 Then     'job isn't assigned yet
                    If b Then
                         With .Range("AE1").Resize(UBound(a) - 1)     'this is the aux range
                              .Sort .Range("a1"), xlAscending, Header:=xlNo     'sort those cells ascending
                              sp = Split(.Cells(1), "|")     'split smallest element into parts
                              arr(i, 1) = sp(1)     'assigned staffmember
                              .Cells(1) = Format(Int(sp(0)) + 1 + Rnd, NF) & "|" & sp(1)     're-enter it with the integer part +1 and a random decimal part
                         End With
                    Else
                         sca.Sort     'sort that SCA
                         a = sca.toarray     'content of SCA to array a
                         sp = Split(a(0), "|")     'split smallest element into parts
                         arr(i, 1) = sp(1)     'assigned staffmember
                         sca.Remove a(0)     'remove that elemnt from the SCA
                         sca.Add Format(Int(sp(0)) + 1 + Rnd, NF) & "|" & sp(1)   're-enter it with the integer part +1 and a random decimal part
                    End If
               End If
          Next

          c3.Value = arr    'write array back to range
     End With
End Sub

 

[BSALV]

small modif abgar

 

[Abgar]

Hi Bsalv,
Thanks again for your input. Unfortunately, i couldn't get your code to work, as running it would present a "Application -defined or object-defined error" message. On Debug, it would show this line:
.Range(ColAux & i - 1).Value = Format(Rnd, NF) & "|" & a(i, 1) 'write values to sheet


However, I've spent some more time refreshing myself on macros, and i've come up with the below code, which works quite well. It's probably a slower way that creating an array, but it works for my needs. I've just copied below in case anyone else gets value from this.

Private Sub NewStaffAllocation()

Dim lr As Long
Dim xCell As Range
Dim yCell As Range
Dim xCellCount As Integer

lr = Cells(Rows.Count, "A").End(xlUp).Row
xCellCount = 0

Application.EnableEvents = False
Application.ScreenUpdating = False
For Each yCell In Range("X2:X" & lr)

    If yCell.Value = "" Then
        yCell.Offset(, 1).Formula = "=Rand()"
        yCell.Offset(, 1).Value = yCell.Offset(, 1).Value
        
    End If
Next yCell

For Each xCell In Range("X2:X" & lr)
    If xCell.Value = "" Then
        xCellCount = xCellCount + 1
        xCell.Formula = "=CHOOSE(ROUNDUP(RANK(RC[1],C[1])/(COUNTA(C[1])/3),0),""Team Member 1"",""Team Member 2"",""Team Member 3"")"
        'The /3 in "(COUNTA(C[1])/3),0)" is the number of admin team members to divide by.  Change the names where required, and add new names following the same sequence (if changing the /3 part as well)
        
        xCell.Value = xCell.Value
    End If
Next xCell

Range("Y:Y").Clear

Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Allocation Successful" & vbCrLf & xCellCount & " new rows allocated", vbCritical: Exit Sub

End Sub

But thanks again Bsalv for putting me in the right frame of mind to come to the above - really appreciate the time you put in to help me.

Cheers