title: Randomly Assign Employees to Tasks
body: <p>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.</p>
  
  <p>My situation is as follows:
  I need to assign a list of employees to tasks. </p>
  
  <ul>
  <li>There will always be MORE tasks than employees.</li>
  <li>Each employee must be assigned to at least ONE</li>
  <li>No employee should be assigned to more than two</li>
  <li>I need the employee list to randomize during the sorting process so the same employees don't get the same tasks over and over</li>
  </ul>
  
  <p>Where I am coming up short is finding a way that starts "assigning" employees, keeps track of how many times the array(i) employee has been assigned, and if it's greater than two, move onto the next. </p>
  
  <p>An awesome user tried helping me here: <a href="https://stackoverflow.com/questions/48364276/excel-vba-to-assign-employees-to-tasks-using-loops?noredirect=1#comment83715653_48364276">Excel VBA to assign employees to tasks using loops</a></p>
  
  <p>Here is the "test" table I am working with:</p>
  
  <p><a href="https://i.stack.imgur.com/b3PZZ.jpg" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/b3PZZ.jpg" alt="Picture of the test table"></a></p>
  
  <p>Here is the macro I have written to sort my list of employees, which works:</p>
  
  <pre><code>Sub ShuffleEmp()
  ' This macro's intention is to shuffle the current liste of process assessors
  
      Application.ScreenUpdating = False
      Dim tempString As String, tempInteger As Integer, i As Integer, j As Integer, lastRow As Integer
  
      ' this grabs the last row with data, so that it can be dynamic
      With Sheets("Test")
          lastRow = .Range("M" &amp; .Rows.Count).End(xlUp).Row
      End With
  
      ' this assumes ALWAYS 45 tasks
      ' starting row 6, going until row 35
      For i = 6 To lastRow
          ' row 6, column 14 (next to Emp column) to start....
          Cells(i, 14).Value = WorksheetFunction.RandBetween(0, 1000)
      Next i
  
          'now it has assigned random values...
  
      For i = 6 To lastRow
          For j = i + 1 To lastRow
              '14 is the number column...
              If Cells(j, 14).Value &lt; Cells(i, 14).Value Then
  
                  'change the string, which is the Emp column...
                  tempString = Cells(i, 13).Value
                  Cells(i, 13).Value = Cells(j, 13).Value
                  Cells(j, 13).Value = tempString
  
                  tempInteger = Cells(i, 14).Value
                  Cells(i, 14).Value = Cells(j, 14).Value
                  Cells(j, 14).Value = tempInteger
              End If
          Next j
      Next i
  
      Worksheets("Test").Range("N:N").EntireColumn.Delete
  
      Application.ScreenUpdating = True
  
  End Sub
  </code></pre>
  
  <p>Here is the macro for turning that list into an array:</p>
  
  <pre><code>Sub EmpArray()
  ' This stores the column of Emps as an array
  
      Dim Storage() As String ' initial storage array to take values
      Dim i As Long
      Dim j As Long
      Dim lrow As Long
  
      lrow = Cells(Rows.Count, "M").End(xlUp).Row ' The amount of stuff in the column
  
      ReDim Storage(1 To lrow - 5)
  
      For i = lrow To 6 Step -1
          If (Not IsEmpty(Cells(i, 13).Value)) Then ' checks to make sure the value isn't empty
              j = j + 1
              Storage(j) = Cells(i, 13).Value
          End If
      Next i
  
      ReDim Preserve Storage(1 To j)
  
      For j = LBound(Storage) To UBound(Storage)  ' loop through the previous array
          MsgBox (Storage(j))
      Next j
  
  
  End Sub
  </code></pre>