Making a schedule with VBA in Excel
<p>I am working on a schedule determining who is going to cook and who is doing dishes for a trip with some friends.
I have the names for the participants listed in column "A" and using CountIf to see how many times the specific person appears on the schedule to make it fair for everyone. The code picks 2 random persons for cooking and 2 for dishes making sure they are not the same. Then putting those names into the schedule I have defined in the worksheet.
My current code looks like this and is working so far as intended.</p>

<pre><code>Private Sub cookplan()
last_row = Range("A1").End(xlDown).Row
Dim awesome()
Dim index1 As Integer
Dim index2 As Integer
Dim cook1 As String
Dim cook2 As String
Dim dish1 As String
Dim dish2 As String
ReDim awesome(last_row - 1, 0)
For i = 0 To last_row - 1
    awesome(i, 0) = Range("A" &amp; i + 1)
Next

For i = 1 To 5
        index1 = Int((last_row - 1 - 0 + 1) * Rnd + 0)
        cook1 = awesome(index1, 0)
        Cells(i * 2, 6).Value = cook1

        Do
            index2 = Int((last_row - 1 - 0 + 1) * Rnd + 0)
            cook2 = awesome(index2, 0)
            Cells(i * 2, 7).Value = cook2
        Loop While cook2 = cook1

        Do
            index1 = Int((last_row - 1 - 0 + 1) * Rnd + 0)
            dish1 = awesome(index1, 0)
        Loop While dish1 = cook1 Or dish1 = cook2

        Do
            index2 = Int((last_row - 1 - 0 + 1) * Rnd + 0)
            dish2 = awesome(index2, 0)
        Loop While dish2 = cook1 Or dish2 = cook2 Or dish2 = dish1

        Cells(i * 2, 8).Value = dish1
        Cells(i * 2, 9).Value = dish2
Next
End Sub
</code></pre>

<p>Is there a way to make a name appear a maximum and minimum number of times? As it is now, 2 or 3 times seems to be a fair number when I run the code and look at the CountIf results.</p>

<p><strong>UPDATE</strong></p>

<p>I have now gotten the code to work as intended. Each person needs at least one cooking and dishes duty, so the coding looks like this now. I know it is not that pretty, but it gets the job done :)</p>

<pre><code>Private Sub cookplan()
last_row = Range("A1").End(xlDown).Row
Dim awesome()
Dim index As Integer
Dim cook1 As String
Dim cook2 As String
Dim dish1 As String
Dim dish2 As String
Dim counter1 As Integer
Dim counter2 As Integer
ReDim awesome(last_row - 2, 0)
For i = 0 To last_row - 2
    awesome(i, 0) = Range("A" &amp; i + 2)
Next
Do
    For i = 1 To 5
        Do
            index = Int((last_row - 2 - 0 + 1) * Rnd + 0)
            cook1 = awesome(index, 0)
            Cells(i * 2, 6).Value = cook1
        Loop While Cells(index + 2, 2) &gt; 2 Or Cells(index + 2, 3) &gt; 2
        Do
            index = Int((last_row - 2 - 0 + 1) * Rnd + 0)
            cook2 = awesome(index, 0)
            Cells(i * 2, 7).Value = cook2
        Loop While Cells(index + 2, 2) &gt; 2 Or Cells(index + 2, 3) &gt; 2 Or cook2 = cook1
        Do
            index = Int((last_row - 2 - 0 + 1) * Rnd + 0)
            dish1 = awesome(index, 0)
            Cells(i * 2, 8).Value = dish1
        Loop While Cells(index + 2, 2) &gt; 2 Or Cells(index + 2, 3) &gt; 2 Or dish1 = cook1 Or dish1 = cook2
        Do
            index = Int((last_row - 2 - 0 + 1) * Rnd + 0)
            dish2 = awesome(index, 0)
            Cells(i * 2, 9).Value = dish2
        Loop While Cells(index + 2, 2) &gt; 2 Or Cells(index + 2, 3) &gt; 2 Or dish2 = cook1 Or dish2 = cook2 Or dish2 = dish1
    Next
    counter1 = 0
    counter2 = 0
    For i = 2 To last_row
        If Cells(i, 2).Value = 0 Then
            counter1 = counter1 + 1
        End If
        If Cells(i, 3).Value = 0 Then
            counter2 = counter2 + 1
        End If
    Next
Loop While counter1 &gt; 0 Or counter2 &gt; 0
End Sub
</code></pre>