This code is not eligant, but it works. It is beeter to manually assign
people to teams to get good random teams. Create a worksheet called
"members" with each of the names in A1:A16. The code will do the rest. It
will create 40 worksheets, name the worksheets, and put the member names in
A1:A4.
Sub make_teams()
'Team combinations
'1 0,1,2,3 4,5,6,7 8,9,a,b c,d,e,f
'2 0,1,6,7 4,5,a,b 8,9,e,f c,d,2,3
'3 0,1,a,b 4,5,e,f 8,9,2,3 c,d,6,7
'4 0,1,e,f 4,5,2,3 8,9,6,7 c,d,a,b
'5 0,2,4,6 1,3,5,7 8,a,c,e 9,b,d,f
'6 0,2,5,7 1,3,c,e 8,a,d,f 9,b,4,6
'7 0,2,c,e 1,3,d,f 8,a,4,6 9,b,5,7
'8 0,2,d,f 1,3,4,6 8,a,5,7 9,b,c,e
'9 0,3,4,7 1,2,5,6 8,b,c,f 9,a,d,e
'10 0,3,5,6 1,2,c,f 8,b,d,e 9,a,4,7
Dim Team(10, 4)
Dim Member(16)
With Sheets("Members")
Set Member_Names = .Range("A1:A16")
'put names into member array
For Mem = 0 To 15
Member(Mem) = .Range("A" & (Mem + 1))
Next Mem
End With
'1 0,1,2,3 4,5,6,7 8,9,a,b c,d,e,f
Team(0, 0) = Array(Member(0), Member(1), Member(2), Member(3))
Team(0, 1) = Array(Member(4), Member(5), Member(6), Member(7))
Team(0, 2) = Array(Member(8), Member(9), Member(10), Member(11))
Team(0, 3) = Array(Member(12), Member(13), Member(14), Member(15))
'2 0,1,6,7 4,5,a,b 8,9,e,f c,d,2,3
Team(1, 0) = Array(Member(0), Member(1), Member(6), Member(7))
Team(1, 1) = Array(Member(4), Member(5), Member(10), Member(11))
Team(1, 2) = Array(Member(8), Member(9), Member(14), Member(15))
Team(1, 3) = Array(Member(12), Member(13), Member(2), Member(3))
'3 0,1,a,b 4,5,e,f 8,9,2,3 c,d,6,7
Team(2, 0) = Array(Member(0), Member(1), Member(10), Member(11))
Team(2, 1) = Array(Member(4), Member(5), Member(14), Member(15))
Team(2, 2) = Array(Member(8), Member(9), Member(2), Member(3))
Team(2, 3) = Array(Member(12), Member(13), Member(6), Member(7))
'4 0,1,e,f 4,5,2,3 8,9,6,7 c,d,a,b
Team(3, 0) = Array(Member(0), Member(1), Member(14), Member(15))
Team(3, 1) = Array(Member(4), Member(5), Member(2), Member(3))
Team(3, 2) = Array(Member(8), Member(9), Member(6), Member(7))
Team(3, 3) = Array(Member(12), Member(13), Member(10), Member(11))
'5 0,2,4,6 1,3,5,7 8,a,c,e 9,b,d,f
Team(4, 0) = Array(Member(0), Member(2), Member(4), Member(6))
Team(4, 1) = Array(Member(1), Member(3), Member(5), Member(7))
Team(4, 2) = Array(Member(8), Member(10), Member(12), Member(14))
Team(4, 3) = Array(Member(9), Member(11), Member(13), Member(15))
'6 0,2,5,7 1,3,c,e 8,a,d,f 9,b,4,6
Team(5, 0) = Array(Member(0), Member(2), Member(5), Member(7))
Team(5, 1) = Array(Member(1), Member(3), Member(12), Member(14))
Team(5, 2) = Array(Member(8), Member(10), Member(13), Member(15))
Team(5, 3) = Array(Member(9), Member(11), Member(4), Member(6))
'7 0,2,c,e 1,3,d,f 8,a,4,6 9,b,5,7
Team(6, 0) = Array(Member(0), Member(2), Member(12), Member(14))
Team(6, 1) = Array(Member(1), Member(3), Member(13), Member(15))
Team(6, 2) = Array(Member(8), Member(10), Member(4), Member(6))
Team(6, 3) = Array(Member(9), Member(11), Member(5), Member(7))
'8 0,2,d,f 1,3,4,6 8,a,5,7 9,b,c,e
Team(7, 0) = Array(Member(0), Member(2), Member(13), Member(15))
Team(7, 1) = Array(Member(1), Member(3), Member(4), Member(6))
Team(7, 2) = Array(Member(8), Member(10), Member(5), Member(7))
Team(7, 3) = Array(Member(9), Member(11), Member(12), Member(14))
'9 0,3,4,7 1,2,5,6 8,b,c,f 9,a,d,e
Team(8, 0) = Array(Member(0), Member(3), Member(4), Member(7))
Team(8, 1) = Array(Member(1), Member(2), Member(5), Member(6))
Team(8, 2) = Array(Member(8), Member(11), Member(12), Member(15))
Team(8, 3) = Array(Member(9), Member(10), Member(13), Member(14))
'10 0,3,5,6 1,2,c,f 8,b,d,e 9,a,4,7
Team(9, 0) = Array(Member(0), Member(3), Member(5), Member(6))
Team(9, 1) = Array(Member(1), Member(2), Member(12), Member(15))
Team(9, 2) = Array(Member(8), Member(11), Member(13), Member(14))
Team(9, 3) = Array(Member(9), Member(10), Member(4), Member(7))
'create worksheets
'i = exercise
For i = 0 To 9
'j = teams
For j = 0 To 3
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Exercise" & (i + 1) & " Team" & (j + 1)
'k = members
For k = 0 To 3
ActiveSheet.Range("A" & (k + 1)) = Team(i, j)(k)
Next k
Next j
Next i
End Sub
