Need help with my Soccer Team generator

[superowls]

I help run a pick up soccer league in my hometown and we are always arguing about unfair/unbalanced teams so I am praying someone on here can help me come up with a macro to solve this. I have created this spreadsheet - https://1drv.ms/x/s!Ailn0TMJeSXLidw46xoEz-WElsxGaw

What I am hoping is the following can be achieved:

1. A button can be pressed to randomly generate teams
2. Teams should include a minimum of 4 defenders, 3 midfielders and 3 attackers
3. Each Team should not exceed "Max Number of Players Per Team"
4. Team score should be an average of Player ratings for that team
5. Team Score should be as close as possible for each team
6. Only players with x in "Present" to be included in the Teams

 

[Logit]

.
This project allows you to enter the skill level of each player and how many teams you want to be generated. Perhaps you can work off of this
code as a starter ?

Option Explicit


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
Dim MyText As String
' Written by Eric W.  1/9/2016
Application.ScreenUpdating = False
Sheets("Sheet1").Range("I2:AK16").Value = ""
' 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")
        r = r + 1
    Wend
    Numplayers = r - 2
    
' Figure out the team sizes
    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 < 100
        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 100 tries." & Chr(10) & Chr(10)
    MyText = MyText & "You may try again using a higher MaxRatingDiff or" & Chr(10)
    MyText = MyText & "add more players to list or decrease the NumTeams"
    MsgBox MyText
    Exit Sub
    
' Print the teams
PrintTeams:
    Range("J1:AP20").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
        Cells(TeamSize(1) + 3, c + 1) = TeamRating(i)
    Next i
Application.ScreenUpdating = True
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)
Dim i As Integer
Dim j As Integer
Dim a, b, c
' 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
            If Players(i, 3) > Players(j, 3) Then
                a = Players(i, 1)
                b = Players(i, 2)
                c = Players(i, 3)
                Players(i, 1) = Players(j, 1)
                Players(i, 2) = Players(j, 2)
                Players(i, 3) = Players(j, 3)
                Players(j, 1) = a
                Players(j, 2) = b
                Players(j, 3) = c
            End If
        Next j
    Next i
    
End Sub

Download workbook : https://www.amazon.com/clouddrive/share/38K7CVsHNgm1H9LB0tyuBLUzaEsJHe3S3A5AfEetqAk