VBA to randomly select teams from list of players

[EinarG]

Excel 2013, Win 7 Pro

Starting with column A (Player Names) and column B (Player rating - value between 0-10), I need a macro to divide the players into either 2, 4 or 6 teams randomly. Column A would have less than 100 names. Teams are named TeamA, TeamB...TeamF. TeamA competes against TeamB, etc.

I have two parameters: NumTeams = Number of teams (2,4 or 6) and MaxRatingDiff = Maximum allowed Team Rating Difference between competing teams

Each team has a rating defined as the average of the ratings of the players on that team.

Competing teams either have the same number of players or one of them (B, D or F) can have an extra player when there is an odd number of players. Example: 23 players, 4 teams would result in player counts of TeamA=6, TeamB=6, TeamC=5, TeamD=6.

I need a VBA Macro to generate approximately even strength teams with the constraint that the difference in team rating between any two competing teams does not exceed MaxRatingDiff. Alternatively, a macro that can be re-run manually (using a command button for example) by the user until he/she is satisfied with the teams. The generated teams should be in columns (Name and Rating) sorted descending by the player rating.

Thanks for help on this or any portion of it!

 

[jwalk65]

This works great! Also, thank you very much for the comments! I think I can make some small changes on my own with help from those. Thank you Eric!

 

[Eric W]

Glad it works for you!

 

[jwalk65]

I'm getting this error way too often when using the pre-assigned 'Team' method:

 'Couldn 't find a team that can hold this group
    Tries = Tries + 1
    If Tries > 1000 Then
        MsgBox "Can't find an equal team distribution in 1000 tries.  Check to see if there are any unworkable player links, " & _
               "such as a grouping that contains 1 male A players, when the maximum number of male A players on any " & _
               "team may be only 2."
        Exit Sub
    End If
    GoTo BigLoop:

Is there anyway to fix this? Instead of this error, maybe giving the closest possible solution? I have found that this error comes up when using the new pre-assigned 'Team' grouping that you created. This error comes up when running the 'getgroups' sub when there are 'Team' grouping links that affect the ratio calculated by the 'getcounts' sub. However, any linkings must take priority over forcing all of the teams to be even.

I have made changes to the program that have actually doubled the amount of player ranks we have. So there is still a regular A male, A female, B male, etc., but there is also now one just for pitchers. So there is an A male pitcher, A female pitcher, etc. as well. This is just to ensure that there is an even spread of pitchers on every team. The problem is that these categories will only have 1-2 players assigned to them in every roster. If one of these pitcher players has a pre-assigned link (such as Team Diamonds), this error almost always comes up. If I remove the pitcher in the pre-assigned link, everything works just fine. I know this because if I remove the Team name and replace it with a random character string, the linking still works.

I'm guessing this is because there is not enough different scenarios the program can calculate, if a team name is locked in a certain spot and there are only one or two teams that get assigned a player from that category, if that makes sense.

 

[Eric W]

Interesting question. I'm sure you're right, the problem is that with a very limited number of pitchers, there are just a very few ways to place them. Off the top of my head, I have 2 ideas that could work.

The easiest one is just to raise the limit from 1000 to 10000. If there really is a valid combination, the program should stumble upon it eventually.

The second way would be to place the pitcher groups before the other groups. Right now the "Team" groups are placed first, then other groups. Sub-option A. If you have a linked pitcher, add the pitcher and whatever links goes with him on a "Team" group. Make sure that there is a team with counts that can handle the enlarged group. So in this scenario, you're essentially manually assigning pitchers, then letting the program assign the rest.

Sub-option B. Create another special type of group. Call a group something like: "Pitcher Group 1", etc. Then you could change the program so that it does the "Team" groups first (like now), then applies the "Pitcher" groups, then all the rest. I think that would be more likely to find a good match.

But it is possible that with all the additional constraints you're adding, there just isn't a solution. In such a case, I suppose we could save the "best" solution. What'd I suggest is if it hits that section of the program, that particular group will be marked "unplaceable" (individuals will always be placeable) and the program would continue placing everything else. When everybody has been placed or marked unplaceable, the number of unplaceable players would be counted, and if that's less than the "best" solution we've found so far, we save that solution and try again. After 1000 tries and we still haven't gotten a solution, we print out the best solution, the teams we set up, plus a list of the unplaced players, which you'd then have to manually handle somehow.

Just some options to consider!

 

[jwalk65]

Interesting question. I'm sure you're right, the problem is that with a very limited number of pitchers, there are just a very few ways to place them. Off the top of my head, I have 2 ideas that could work.

The easiest one is just to raise the limit from 1000 to 10000. If there really is a valid combination, the program should stumble upon it eventually.

It still can't find a solution, even if I bump it up to 100,000.

The second way would be to place the pitcher groups before the other groups. Right now the "Team" groups are placed first, then other groups. Sub-option A. If you have a linked pitcher, add the pitcher and whatever links goes with him on a "Team" group. Make sure that there is a team with counts that can handle the enlarged group. So in this scenario, you're essentially manually assigning pitchers, then letting the program assign the rest.

Sub-option B. Create another special type of group. Call a group something like: "Pitcher Group 1", etc. Then you could change the program so that it does the "Team" groups first (like now), then applies the "Pitcher" groups, then all the rest. I think that would be more likely to find a good match.

I think with Sub-option A, they are better off not even using designated pitching categories. They can just as easy make manual switches to the draft results after it ran like it did before. I'm not sure I 100% understand Sub-option B. Would it be assigning pitcher groups to designated team groups?

But it is possible that with all the additional constraints you're adding, there just isn't a solution. In such a case, I suppose we could save the "best" solution. What'd I suggest is if it hits that section of the program, that particular group will be marked "unplaceable" (individuals will always be placeable) and the program would continue placing everything else. When everybody has been placed or marked unplaceable, the number of unplaceable players would be counted, and if that's less than the "best" solution we've found so far, we save that solution and try again. After 1000 tries and we still haven't gotten a solution, we print out the best solution, the teams we set up, plus a list of the unplaced players, which you'd then have to manually handle somehow.

Just some options to consider!

I'm not sure this is entirely true though. For instance I had a team linking for 1 D Male Player and 1 B Male Pitcher. The distribution showed that one team was capable of this, as one team had had a 1 in each of these categories. And if I take out the team name and use a random matching string, it works fine. There has to be something with how the pre-assigned players are assigned to the teams that are causing the issue.

Even if there was a way to point at the player causing the issue, I think it would help.

Thanks Eric!

 

[Usercode]

Hi Eric, I know this is an old post, but I couldn't run this code. I keep getting a Run-time error 13: Type mismatch

Highlighted line is this:
For i = 1 To Numplayers
TeamRating(t) = TeamRating(t) + Players(i, 2)
tc = tc + 1

Is there a working excel file for this? thanks.

 

[Eric W]

John, I'm not sure what else I can do. If you send me your email address in a PM, I'll send you mine, and you can send me your latest workbook, with your code changes and the player list, with pitchers, and I can look at it and see if there's anything I can do. No promises though, my time is tight right now.

@Usercode, the only reason I can see that you'd get that error is if you have a non-numeric value in the rating column. In that previous program, it expects scores to be numeric and in column B. Look for non-numeric values, words, or errors, and change it to a number and see if that fixes it. I wrote that a year and a half ago. I'd make some changes if I wrote it today, but it should still work.

 

[mrc44]

Thanks! I checked it. It is working now.

 

[nawazalikhan007]

Hi Eric,Awesome,I have similar query, I need urgent solution and code for the below problem statement??? Thanks in Advance

	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Background
2		- We are trying to automate the team selection process for different states for Ranji Tournament
3		- The selection process involves using Player Statistics and some inputs to determine the ideal team composition for different states
4		- This assignment will allow you to use excel automation to select cricket players for different states for Ranji trophy.
5
6	Problem Statement
7		We need to select the best team for EACH STATE
8		Given a set of player information, some selection criteria and the required number of players at each position as input,automatically mark whether a player is selected or not for his state team
9		The worksheet should automatically handle the following changes:
10			- Changes in team composition (Number of Batsman, Number of Bowlers and Number of All Rounders)
11			- Addition of more states in the dataset
12			- Changes in the data set (Batting Averages / Wickets and Wicketkeeper flag)
13
14	Data Available:
15		1) Player Info: Each player's info is given in the Player_Statistics sheet and contains following details:
16			- Player Name
17			- State
18			- Position (Batsman/ Bowler/ Allrounder)
19			- Batting Average
20			- Bowling Average (Wickets/ Match)
21			- isWicketkeeper
22
23		2) Required Team Composition:
24			- The required number of players at each position (batsman, bowler or allrounder)
25			- Please refer to Required_Team_Composition sheet
26
27		3) Selection Criteria:
28			- There has to be one wicketkeeper-batsman in the team. In case there are multiple candidate wicketkeepers in the state, the one with highest batting average is selected
29			- Select the remaining number of required batsmen in a decreasing order of their batting averages
30			- Select the required number of bowlers in the decreasing order of wickets/match
31			- Select the allrounders based on the formula (Batting average + 5*wickets/match). The higher this value, the better the allrounder and needs to be chosen
32
33	Output Required:
34		1) The "isSelected" flag should have an output "True/ False" for each row in "Player_statistics" sheet indicating whether a player is selected based on the criteria or not.
35
36	Process & Instructions:
37		1) To get the selected players, you should write excel formulas or VBA macros which populate the value of isSelected
38			- If needed, you can add columns to the right of isSelected which would help you in the processing
39		2) The submitted solution should be generic so that it should work on changing the Player Info and the required team composition
40
41

<thead>
</thead><tbody>
</tbody>

	A	B	C	D	E	F	G
1	Player Name	State	Position	Batting Average	Wickets / Match	IsWicketKeeper	IsSelected
2	P1	Maharashtra	Batsman	24	1	1
3	P2	Maharashtra	Batsman	11	1	1
4	P3	Maharashtra	Batsman	17	2	0
5	P4	Maharashtra	Batsman	45	2	0
6	P5	Maharashtra	Batsman	22	1	0
7	P6	Maharashtra	Batsman	16	2	0
8	P7	Maharashtra	Bowler	20	2	0
9	P8	Maharashtra	Bowler	16	3	0
10	P9	Maharashtra	Bowler	15	4	0
11	P10	Maharashtra	Bowler	24	4	0
12	P11	Maharashtra	Bowler	18	3	0
13	P12	Maharashtra	Bowler	5	4	0
14	P13	Maharashtra	Bowler	9	3	0
15	P14	Maharashtra	Bowler	21	2	0
16	P15	Maharashtra	All Rounder	24	4	0
17	P16	Maharashtra	All Rounder	33	3	0
18	P17	Maharashtra	All Rounder	31	4	0
19	P18	Maharashtra	All Rounder	20	2	0
20	P19	Maharashtra	All Rounder	17	2	0
21	P20	Maharashtra	All Rounder	11	3	0
22	P21	Karnataka	Batsman	29	1	1
23	P22	Karnataka	Batsman	46	0	1
24	P23	Karnataka	Batsman	16	2	1
25	P24	Karnataka	Batsman	34	1	0
26	P25	Karnataka	Batsman	49	2	0
27	P26	Karnataka	Batsman	30	2	0
28	P27	Karnataka	Bowler	19	2	0
29	P28	Karnataka	Bowler	8	2	0
30	P29	Karnataka	Bowler	10	4	0
31	P30	Karnataka	Bowler	8	2	0
32	P31	Karnataka	Bowler	11	3	0
33	P32	Karnataka	Bowler	18	2	0
34	P33	Karnataka	Bowler	19	2	0
35	P34	Karnataka	Bowler	11	2	0
36	P35	Karnataka	All Rounder	39	3	0
37	P36	Karnataka	All Rounder	47	4	0
38	P37	Karnataka	All Rounder	34	3	0
39	P38	Karnataka	All Rounder	44	3	0
40	P39	Karnataka	All Rounder	33	3	0
41	P40	Karnataka	All Rounder	24	4	0
42	P41	Karnataka	Bowler	20	4	0
43	P42	Delhi	Batsman	17	0	0
44	P43	Delhi	Batsman	24	0	0
45	P44	Delhi	Batsman	17	1	1
46	P45	Delhi	Batsman	33	0	1
47	P46	Delhi	Batsman	31	2	0
48	P47	Delhi	Batsman	33	1	0
49	P48	Delhi	Bowler	19	3	0
50	P49	Delhi	Bowler	19	2	0
51	P50	Delhi	Bowler	21	2	0
52	P51	Delhi	Bowler	17	3	0
53	P52	Delhi	Bowler	13	4	0
54	P53	Delhi	Bowler	17	4	0
55	P54	Delhi	Bowler	13	2	0
56	P55	Delhi	Bowler	21	3	0
57	P56	Delhi	All Rounder	32	3	0
58	P57	Delhi	All Rounder	28	2	0
59	P58	Delhi	All Rounder	17	3	0
60	P59	Delhi	All Rounder	34	2	0
61	P60	Delhi	All Rounder	44	2	0
62	P61	Delhi	All Rounder	28	2	0
63	P62	Delhi	Batsman	26	1	1
64	P63	Delhi	Bowler	21	2	0 A B 1 2 Per Team Composition 3 Batsman 4 4 Bowler 3 5 All Rounder 4 <thead> </thead><tbody> </tbody>

<thead>
</thead><tbody>
</tbody>

I just noticed that I missed your request that the teams be sorted in descending order of rating. Here's a version that includes that. I also made a few other tweaks to it, mostly adding some extra error checking and improving the sort.

Sub MakeTeams()
Dim Players(200, 3), TeamSize(10) As Integer, TeamRating(10) As Double
Dim i As Integer, r As Integer, j As Integer, c As Integer, ctr As Integer
Dim NumPlayers As Integer, NumTeams As Integer, trials As Integer
Dim t As Integer, tc As Integer, MaxRating As Double, MinRating As Double
' Written by Eric W.  1/9/2016

' How many teams?
    NumTeams = Range("D2").Value
    If NumTeams > 10 Or NumTeams < 2 Or Int(NumTeams) <> NumTeams Then
        MsgBox "The number of teams must be an integer from 2-10."
        Exit Sub
    End If
    
' Read all the players and ratings
    r = 2
    Erase Players, TeamSize, TeamRating
    
    While Cells(r, "A") <> ""
        If r > 201 Then
            MsgBox "The number of players must be under 200."
            Exit Sub
        End If
        Players(r - 1, 1) = Cells(r, "A")
        Players(r - 1, 2) = Cells(r, "B")
        If Not IsNumeric(Players(r - 1, 2)) Then
            MsgBox "One of the ratings is not a number."
            Exit Sub
        End If
        r = r + 1
    Wend
    NumPlayers = r - 2
    
' Figure out the team sizes
    If NumTeams > NumPlayers Then
        MsgBox "You must have at least 1 player per team.  Make sure there are no gaps in the player list."
        Exit Sub
    End If
    For r = 1 To NumTeams
        TeamSize(r) = Int(NumPlayers / NumTeams) + IIf(r <= (NumPlayers Mod NumTeams), 1, 0)
    Next r
    
' Make random teams
    trials = 0
    While trials < 250
        Call Shuffle(Players, NumPlayers)
        
' Figure out the team ratings
        t = 1
        tc = 1
        Erase TeamRating
        MaxRating = -1
        MinRating = 11
        For i = 1 To NumPlayers
            TeamRating(t) = TeamRating(t) + Players(i, 2)
            tc = tc + 1
            If tc > TeamSize(t) Then
                TeamRating(t) = TeamRating(t) / TeamSize(t)
                If TeamRating(t) > MaxRating Then MaxRating = TeamRating(t)
                If TeamRating(t) < MinRating Then MinRating = TeamRating(t)
                t = t + 1
                tc = 1
            End If
        Next i

' Max team rating - min team rating within the limit?
        If MaxRating - MinRating <= Cells(2, "F") Then GoTo PrintTeams
        
' Nope, try again
        trials = trials + 1
    Wend
    
    MyText = "Unable to find a valid set of teams in 250 tries." & Chr(10) & Chr(10)
    MyText = MyText & "You may try again, or try again with a higher MaxRatingDiff."
    MsgBox MyText
    Exit Sub
    
' Print the teams
PrintTeams:
    Range("I1:AP100").ClearContents
    ctr = 1
    For i = 1 To NumTeams
        c = i * 3 + 6
        Cells(1, c) = "Team " & Chr(64 + i)
        For j = 1 To TeamSize(i)
            Cells(j + 1, c) = Players(ctr, 1)
            Cells(j + 1, c + 1) = Players(ctr, 2)
            ctr = ctr + 1
        Next j
        
        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Cells(2, c + 1), Order:=xlDescending
            .SetRange Range(Cells(2, c), Cells(TeamSize(1) + 1, c + 1))
            .Apply
        End With
        Cells(TeamSize(1) + 3, c + 1) = TeamRating(i)
    Next i
    
End Sub
' This team will randomly shuffle the players
' (It's really a bad sort, but with under 100 players, it should be good enough.)
Sub Shuffle(ByRef Players, ByVal NumPlayers)

' Assign a random number to each player
    For i = 1 To NumPlayers
        Players(i, 3) = Rnd()
    Next i
    
' Now sort by the random numbers
    For i = 1 To NumPlayers
        For j = 1 To NumPlayers - i
            If Players(j, 3) > Players(j + 1, 3) Then
                a = Players(j, 1)
                b = Players(j, 2)
                c = Players(j, 3)
                Players(j, 1) = Players(j + 1, 1)
                Players(j, 2) = Players(j + 1, 2)
                Players(j, 3) = Players(j + 1, 3)
                Players(j + 1, 1) = a
                Players(j + 1, 2) = b
                Players(j + 1, 3) = c
            End If
        Next j
    Next i
    
End Sub

 

[Eric W]

Welcome to the forum.

This has the appearance of some type of school assignment. In general, people here don't like doing other people's homework. We feel it's counterproductive, and does not help the student learn the subject. An occasional hint, or answering a question about a specific part of the project is OK. (Like "how do I find the last row in the table, and read it all into an array?"). But asking someone to do the whole assignment is a bit much.

If you have some experience with programming, there are several complete, working programs in this thread that do similar functions. You should be able to adapt one of them. Your program actually looks like it would be substantially easier. The selection criteria are well-defined, there's no need to run multiple scenarios.

If you don't have programming experience, you might be better off with formulas. For example, put =D2*F2 in H2, and drag down. Then pick the maximum value in column H for each team, and you have your wicketkeeper. Next column over, use LARGE to get the largest batsmen values, excluding the wicket keeper. Next column over, same for the bowlers. Next column over, create the all-rounder formula, and one more column over, use LARGE on that. Plenty of details to work out, but that's where the learning comes in.

Incidentally, even if this weren't an assignment, it looks pretty time-consuming. People here are volunteers and have limited time. This is large enough that you might even need to hire a consultant. I don't have time enough to take this on right now.

So there are some ideas for you. Pick something and dig in. Good luck!