Randomly Assign Employees to Tasks

Question

This is a follow-up to a previous question that I had. I was provided an answer, but due to my own inexperience and inability, I can\'t seem to implement it properly.

My

Answer 1

This is your entire program here. It's tested and works. The only problem is that your screenshot didn't show the row and column headers, so I had to assume that Task was column B, row 1.

Here is your main Subroutine. This is the program that you will assign your button to. This will automatically check to see if your employeeList is uninitialized (basically empty) and rebuild it using the function buildOneDimArr.

Sub assignEmployeeTasks()

    Dim ws As Worksheet, i As Long
    Set ws = ThisWorkbook.Worksheets(1)
    Dim employeeList() As Variant

    With ws
        For i = 2 To lastRow(ws, 2)
            If (Not employeeList) = -1 Then
                'rebuild employeelist / array uninitialized
                employeeList = buildOneDimArr(ws, "F", 2, lastRow(ws, "F"))
            End If
            .Cells(i, 4) = randomEmployee(employeeList)
        Next
    End With

End Sub

These are the "support" functions that allow your program to do it's job:

Function randomEmployee(ByRef employeeList As Variant) As String

    'Random # that will determine the employee chosen
    Dim Lotto As Long
    Lotto = randomNumber(LBound(employeeList), UBound(employeeList))
    randomEmployee = employeeList(Lotto)

    'Remove the employee from the original array before returning it to the sub
    Dim retArr() As Variant, i&, x&, numRem&
    numRem = UBound(employeeList) - 1
    If numRem = -1 Then     'array is empty
        Erase employeeList
        Exit Function
    End If
    ReDim retArr(numRem)
    For i = 0 To UBound(employeeList)
        If i <> Lotto Then
            retArr(x) = employeeList(i)
            x = x + 1
        End If
    Next i
    Erase employeeList
    employeeList = retArr

End Function

' This will take your column of employees and place them in a 1-D array
Function buildOneDimArr(ByVal ws As Worksheet, ByVal Col As Variant, _
        ByVal rowStart As Long, ByVal rowEnd As Long) As Variant()

    Dim numElements As Long, i As Long, x As Long, retArr()
    numElements = rowEnd - rowStart
    ReDim retArr(numElements)

    For i = rowStart To rowEnd
        retArr(x) = ws.Cells(i, Col)
        x = x + 1
    Next i

    buildOneDimArr = retArr

End Function

' This outputs a random number so you can randomly assign your employee
Function randomNumber(ByVal lngMin&, ByVal lngMax&) As Long
    'Courtesy of https://stackoverflow.com/a/22628599/5781745
    Randomize
    randomNumber = Int((lngMax - lngMin + 1) * Rnd + lngMin)
End Function

' This gets the last row of any column you specify in the arguments
Function lastRow(ws As Worksheet, Col As Variant) As Long
    lastRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row
End Function

You are going to want to place all of these into a standard module.