Generating Random Teams While Rotating Players In

Starlix

New Member
Hi All, I ran into a wall and hope someone can help.

I currently have a clunky spreadsheet that will randomly distribute 16 people into 4 teams of 4 for our volleyball games. What I actually need to do is for the spreadsheet to distribute 20 people into 4 teams of 4, and hold the 4 remaining people aside so they can part of the next randomized 4 teams of 4. Rinse and repeat. In the end, everyone needs to play 8 games. And one more complication; the girls need to be evenly distributed amongst the teams.

Any help would be greatly appreciated as I don't even know how to approach this. Thank you much!

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

lrobbo314

Well-known Member
Assuming that you have your names in Column A, and that A1 is a header row, the following code should do what you are looking for.

Code:
``````Sub createTeams()
Dim AL As Object:           Set AL = CreateObject("System.Collections.ArrayList")
Dim r As Range:             Set r = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:        AR = r.Value
Dim TeamSize As Integer:    TeamSize = 4
Dim NumTeams As Integer:    NumTeams = UBound(AR) / TeamSize
Dim Result() As Variant:    ReDim Result(1 To TeamSize + 1, 1 To NumTeams)
Dim IDX As Integer

For i = 1 To UBound(AR)
Next i

For j = 1 To NumTeams
If j < NumTeams Then
Result(j, 1) = "Team " & j
Else
Result(j, 1) = "Alternates"
End If

For k = 1 To TeamSize
IDX = Int((AL.Count) * Rnd())
Result(j, k + 1) = AL(IDX)
AL.removeat IDX
Next k
Next j

Range("B1").Resize(UBound(Result, 1), UBound(Result, 2)).Value = Application.Transpose(Result)

End Sub``````

Starlix

New Member
This works so much better than what I'm currently using. I'll do the other parts manually. Thanks so much Irobb314!

Replies
2
Views
401
Replies
2
Views
384
Replies
3
Views
284

1,127,090
Messages
5,622,649
Members
415,916
Latest member
eugenia

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back