Excel VBA to assign employees to tasks using loops

Question

Good afternoon,

I am working on an innovative project and cannot seem to figure out the logic of what I need to do. Essentially, I am trying to assign a number of employees to tasks (right now just filling in numbers instead of their names and the actual tasks). Here is a basic look at what the spreadsheet looks like

Task | Task Location | Task Materials | Difficulty | Assignee | Employee List

There are currently 45 tasks, and 30 employees. What I need to do is:

• Randomly assort the list of employees to randomize who is doing what
• Check to see IF the employee has already been scheduled for 2 tasks, as everybody should have AT LEAST one with nobody having less than two
• Loop through the "Employee List" column, IF the Task is blank AND the Employee hasn't been scheduled for more than 2 tasks already, copy that current value from Employee List into Assignee column.

I know this is vague, but I really would appreciate the help. I think the steps are three fold:

1. Randomize Employee List column
2. Assign each employee once
3. Re-randomize employee list
4. Check to see which tasks still need assigning, and then check to see if the employee has already been scheduled for 2, and, if not, assign them
5. If they have, skip over and move to the next one

Could anybody help me devise a solution? Here is my current code, which sorts the column, and works well:

Sub ShufflePA()

    Application.ScreenUpdating = False

    Dim tempString As String, tempInteger As Integer, i As Integer, j As Integer, lastRow As Integer

    With Sheets("Test")
        lastRow = .Range("F" & .Rows.count).End(xlUp).Row
    End With

    For i = 6 To lastRow
        Cells(i, 7).Value = WorksheetFunction.RandBetween(0, 1000)
    Next i


    For i = 6 To lastRow
        For j = i + 1 To lastRow
            If Cells(j, 7).Value < Cells(i, 7).Value Then

                'change the string, which is the pa column...
                tempString = Cells(i, 6).Value
                Cells(i, 6).Value = Cells(j, 6).Value
                Cells(j, 6).Value = tempString

                tempInteger = Cells(i, 7).Value
                Cells(i, 7).Value = Cells(j, 7).Value
                Cells(j, 7).Value = tempInteger
            End If
        Next j
    Next i

    Worksheets("Test").Range("N:N").EntireColumn.Delete

    Application.ScreenUpdating = True

End Sub

I recognize I'll likely need some more subs, and would be willing to work with anybody who could help me. In advance, thank you very much. I am struggling to develop the logic to accomplish what I need.

Answer 1

Try this method for randomly assigning your employees.

Note: You will need to assign your employee column to an array

Here is the Function that will take an array of your employees, and output a random name:

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
    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

Notice how I used ByRef? This was intentional because it will replace the input array you provided with a new array that contains all the names, except the one that the function used to give you your random name.

You will also need this function to choose your random number that is called in the above function:

Function randomNumber(ByVal lngMin&, ByVal lngMax&) As Long
    'Courtesy of https://stackoverflow.com/a/22628599/5781745
    randomNumber = Int((lngMax - lngMin + 1) * Rnd + lngMin)
End Function

This was the test sub I had used. Obviously, you don't want to keep my empListArr, but I kept it there so you can see how this works.

Sub test()

    Dim empListArr()
    empListArr = Array("Bob", "Joe", "Erin", "Amber")

    Debug.Print "Employee Chosen: " & randomEmployee(empListArr)

    Dim i As Long
    For i = 0 To UBound(empListArr)
        Debug.Print "Remaining Employee: ";
        Debug.Print empListArr(i)
    Next

End Sub

Again, the Test() sub is not intended to be added to your code. It serves as a general guide on using your array of employees with the randomEmployee function.

So put your tasks in a loop, assigning each task one at a time with the randomEmployee function. This function will remove the employees as they are assigned.

Once your array of employees are exhausted you need to reassign your entire column of employees to your array again, so ensure you include a system that checks if your array is empty or not.

Edit:

I performed a test on the randomNumber function just to see how "random" it actually was, using a range between 0 to 10 on a million lines:

Each result hit roughly 9.1%, so it appears to be pretty reliable.