Home |
Search |
Today's Posts |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 " wrote: I have a 16 names in excel sheet and I am planning to give a 10 exercises( as team-work) I would like to assign names to different group on excel so each time they will have a different member of group, each team consist of 4 members. I would like to see each group in different sheet ( if you can ) thanks a lot |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Formula to group First/Last names 2 one cell | Excel Worksheet Functions | |||
Repeat group names on each page | Excel Discussion (Misc queries) | |||
Alphabetizing within a group of same names in XPExcel2002 column? | Excel Discussion (Misc queries) | |||
Pivot table - don't group names | Excel Discussion (Misc queries) | |||
Excel 2000 reading the group names from a pivot table | Excel Programming |