Problem:
There are N Soccer players in the format below and the sheet will spit out every 11-player combination of the players.
Each 11-player line-up must follow the constraints below.
It should be able to select players as 'core' meaning that they will appear in 100% of the output line-ups.
Input:
A B C D E
Name Position Team Salary Core Player? 1="Yes",0="No"
Darron Gibson M EVE 6500000 0
Riyad Mahrez M LEI 11700000 0
Andrej Kramaric F LEI 6900000 0
Sadio Mané M SOT 12600000 0
Victor Anichebe F WBA 5300000 1
Serge Gnabry M WBA 6300000 0
Dimitri Payet M WHM 13500000 0
Juan Mata M MUN 10700000 0
.
.
.so on there is list of players
Constraints for each team:
Maximum Salary 100000000 Allowed per team
'These are the maximum and minimum no. of players for a position per team
Position Min Max
G 1 1
D 3 4
M 3 5
F 1 3
'there can be maximum no. of four players from a single team
' e.g. MUN (manchester united)
Maximum Number of Players from one team 4
Total number of players 11 'Total no. of players per team
Output Example:
Player 1 Player 2 Player 3 Player 4 Player 5 Player 6 Player 7 Player 8 Player 9 Player 10 Player 11
Player 1 Player 2 Player 3 Player 4 Player 5 Player 6 Player 7 Player 8 Player 9 Player 10 Player 12
Player 1 Player 2 Player 3 Player 4 Player 5 Player 6 Player 7 Player 8 Player 9 Player 10 Player 13
Player 1 Player 2 Player 3 Player 4 Player 5 Player 6 Player 7 Player 8 Player 9 Player 10 Player 14
.
.
.
.
'Update: Players can be repeated in another teams but no match for full line up is allowed
Like this is not allowed
Player 1 Player 2 Player 3 Player 4 Player 5 Player 6 Player 7 Player 8 Player 9 Player 10 Player 11
Player 1 Player 3 Player 2 Player 5 Player 4 Player 6 Player 7 Player 8 Player 9 Player 10 Player 11
Attached File
My idea was to first place them and then check for constraints as the order in which they are selected doesn't matters and make them correct until the conditions are satisfied but this getting complex on every stage.
What I've tried (Not complete):
Option Explicit
Sub Teams()
Dim wi, wo, wt, ws As Worksheet
Dim i, j, l, d, m, ct, c, a, b, r As Long
Dim TotalG, TotalD, TotalM, TotalF, TotalSal, Sal, SalLeft, MaxTeam As Long
Dim Team, Pos, Name As String
Dim FinalRowI, FinalRowO As Long
Dim Drng As Range
Dim Mrng As Range
Set wi = Sheet1
Set wo = Sheet2
Set wt = Sheet3
Set ws = Sheet4
FinalRowI = wi.Range("A900000").End(xlUp).Row
TotalG = 0
TotalD = 0
TotalM = 0
TotalF = 0
Sal = 0
SalLeft = 0
TotalSal = wi.Range("H14").Value
For i = 2 To FinalRowI
Name = Trim(wi.Range("A" & i).Text)
Pos = Trim(wi.Range("B" & i).Text)
Team = Trim(wi.Range("C" & i).Text)
Sal = wi.Range("D" & i).Value
Select Case Pos
Case "G"
TotalG = TotalG + 1
Case "D"
TotalD = TotalD + 1
Case "M"
TotalM = TotalM + 1
Case "F"
TotalF = TotalF + 1
Case Else
End Select
Next i
MaxTeam = (WorksheetFunction.Min(CInt(TotalD), CInt(TotalM))) / 3
MaxTeam = (WorksheetFunction.Min(CInt(MaxTeam), CInt(TotalG), CInt(TotalF)))
MsgBox "MaxTeam " & MaxTeam
MsgBox "G " & TotalG
MsgBox "D " & TotalD
MsgBox "M " & TotalM
MsgBox "F " & TotalF
m = 0
d = 0
c = 1
ct = 1
a = 1
r = 1
l = 3
b = 6
'Place all the Min Goalkeepers,Forwards, Mid, Defenders
For i = 2 To FinalRowI
Name = Trim(wi.Range("A" & i).Text)
Pos = Trim(wi.Range("B" & i).Text)
Team = Trim(wi.Range("C" & i).Text)
Sal = wi.Range("D" & i).Value
Select Case Pos
Case "G"
If ct <= MaxTeam Then
wo.Range("A" & ct) = Name
wt.Range("A" & ct) = Team
ws.Range("A" & ct) = Sal
ct = ct + 1
Else: End If
Case "D"
If d <= 3 * MaxTeam And r <= MaxTeam Then
wo.Cells(r, l) = Name
wt.Cells(r, l) = Team
ws.Cells(r, l) = Sal
d = d + 1
If d Mod 3 = 0 Then
r = r + 1
l = 3
Else
l = l + 1
End If
Else: End If
Case "M"
If m <= 3 * MaxTeam And a <= MaxTeam Then
wo.Cells(a, b) = Name
wt.Cells(a, b) = Team
ws.Cells(a, b) = Sal
m = m + 1
If m Mod 3 = 0 Then
a = a + 1
b = 6
Else
b = b + 1
End If
Else: End If
Case "F"
If c <= MaxTeam Then
wo.Range("B" & c) = Name
wt.Range("B" & c) = Team
ws.Range("B" & c) = Sal
c = c + 1
Else: End If
Case Else
End Select
Next i
Set Drng = wo.Range(Cells(1, 3), Cells(MaxTeam, 5))
Set Mrng = wo.Range(Cells(1, 6), Cells(MaxTeam, 8))
m = 8
d = 8
c = 0
ct = 0
a = 1
b = 1
l = 3
b = 6
'For Rest of three Places
For i = 2 To FinalRow
Name = Trim(wi.Range("A" & i).Text)
Pos = Trim(wi.Range("B" & i).Text)
Team = Trim(wi.Range("C" & i).Text)
Sal = wi.Range("D" & i).Value
Select Case Pos
Case "G"
Case "D"
For Each c In Drng
Next j
Case "M"
Case "F"
Case Else
End Select
Next i
End Sub
Consider an SQL solution which runs random iterations of the 11-player sequence and validates each iteration to meet all required conditions. MS Access, which works great with its Office sibling MS Excel can be a viable solution. Also, any RDMS can run below in a stored procedure. Below is the sequence of events and needed objects. Here is the MS Access accdb app empty of any picks for your testing.
Table
First, create a final table SoccerPicks
to hold all 11 member teams which will grow over lifetime of app. It is used in append query called by VBA module below, inserting a successfully validated team record per each looped iteration.
Cross Join Query
Second, create a randomized Cross Join Query (returns all possible combinations of a choice set) but selects one player per 11 player tables and conditions the Positions (G, D, M, F) counts. In the FROM
clause, the first four correspond to four core players and these individuals will show up on every team. Replicate their derived tables for more or remove and copy a randomized derived table as the other 7 are set up.
SELECT Player1, Player2, Player3, Player4, Player5, Player6,
Player7, Player8, Player9, Player10, Player11,
(t1.Salary + t2.Salary + t3.Salary + t4.Salary + t5.Salary + t6.Salary +
t7.Salary + t8.Salary + t9.Salary + t10.Salary + t11.Salary) AS TeamSalary,
IIF(t1.Position = 'G', 1, 0) + IIF(t2.Position = 'G', 1, 0) +
IIF(t3.Position = 'G', 1, 0) + IIF(t4.Position = 'G', 1, 0) +
IIF(t5.Position = 'G', 1, 0) + IIF(t6.Position = 'G', 1, 0) +
IIF(t7.Position = 'G', 1, 0) + IIF(t8.Position = 'G', 1, 0) +
IIF(t9.Position = 'G', 1, 0) + IIF(t10.Position = 'G', 1, 0) +
IIF(t11.Position = 'G', 1, 0) AS GPosition,
IIF(t1.Position = 'D', 1, 0) + IIF(t2.Position = 'D', 1, 0) +
IIF(t3.Position = 'D', 1, 0) + IIF(t4.Position = 'D', 1, 0) +
IIF(t5.Position = 'D', 1, 0) + IIF(t6.Position = 'D', 1, 0) +
IIF(t7.Position = 'D', 1, 0) + IIF(t8.Position = 'D', 1, 0) +
IIF(t9.Position = 'D', 1, 0) + IIF(t10.Position = 'D', 1, 0) +
IIF(t11.Position = 'D', 1, 0) AS DPosition,
IIF(t1.Position = 'M', 1, 0) + IIF(t2.Position = 'M', 1, 0) +
IIF(t3.Position = 'M', 1, 0) + IIF(t4.Position = 'M', 1, 0) +
IIF(t5.Position = 'M', 1, 0) + IIF(t6.Position = 'M', 1, 0) +
IIF(t7.Position = 'M', 1, 0) + IIF(t8.Position = 'M', 1, 0) +
IIF(t9.Position = 'M', 1, 0) + IIF(t10.Position = 'M', 1, 0) +
IIF(t11.Position = 'M', 1, 0) AS MPosition,
IIF(t1.Position = 'F', 1, 0) + IIF(t2.Position = 'F', 1, 0) +
IIF(t3.Position = 'F', 1, 0) + IIF(t4.Position = 'F', 1, 0) +
IIF(t5.Position = 'F', 1, 0) + IIF(t6.Position = 'F', 1, 0) +
IIF(t7.Position = 'F', 1, 0) + IIF(t8.Position = 'F', 1, 0) +
IIF(t9.Position = 'F', 1, 0) + IIF(t10.Position = 'F', 1, 0) +
IIF(t11.Position = 'F', 1, 0) AS FPosition
FROM
(SELECT PlayerName as Player1, Position, Team, Salary
FROM Soccer
WHERE [Core Player] = True AND
(SELECT Count(*) FROM Soccer sub
WHERE sub.ID <= Soccer.ID
AND sub.[Core Player] = True
AND Soccer.[Core Player] = True) = 1) AS t1,
(SELECT PlayerName as Player2, Position, Team, Salary
FROM Soccer
WHERE [Core Player] = True AND
(SELECT Count(*) FROM Soccer sub
WHERE sub.ID <= Soccer.ID
AND sub.[Core Player] = True
AND Soccer.[Core Player] = True) = 2) AS t2,
(SELECT PlayerName as Player3, Position, Team, Salary
FROM Soccer
WHERE [Core Player] = True AND
(SELECT Count(*) FROM Soccer sub
WHERE sub.ID <= Soccer.ID
AND sub.[Core Player] = True
AND Soccer.[Core Player] = True) = 3) AS t3,
(SELECT PlayerName as Player4, Position, Team, Salary
FROM Soccer
WHERE [Core Player] = True AND
(SELECT Count(*) FROM Soccer sub
WHERE sub.ID <= Soccer.ID
AND sub.[Core Player] = True
AND Soccer.[Core Player] = True) = 4) AS t4,
(SELECT TOP 1 PlayerName AS Player5, Position, Team, Salary
FROM Soccer ORDER BY Rnd(ID)) AS t5,
(SELECT TOP 1 PlayerName AS Player6, Position, Team, Salary
FROM Soccer ORDER BY Rnd(ID)) AS t6,
(SELECT TOP 1 PlayerName AS Player7, Position, Team, Salary
FROM Soccer ORDER BY Rnd(ID)) AS t7,
(SELECT TOP 1 PlayerName AS Player8, Position, Team, Salary
FROM Soccer ORDER BY Rnd(ID)) AS t8,
(SELECT TOP 1 PlayerName AS Player9, Position, Team, Salary
FROM Soccer ORDER BY Rnd(ID)) AS t9,
(SELECT TOP 1 PlayerName AS Player10, Position, Team, Salary
FROM Soccer ORDER BY Rnd(ID)) AS t10,
(SELECT TOP 1 PlayerName AS Player11, Position, Team, Salary
FROM Soccer ORDER BY Rnd(ID)) AS t11
WHERE
IIF(t1.Position = 'G', 1, 0) + IIF(t2.Position = 'G', 1, 0) +
IIF(t3.Position = 'G', 1, 0) + IIF(t4.Position = 'G', 1, 0) +
IIF(t5.Position = 'G', 1, 0) + IIF(t6.Position = 'G', 1, 0) +
IIF(t7.Position = 'G', 1, 0) + IIF(t8.Position = 'G', 1, 0) +
IIF(t9.Position = 'G', 1, 0) + IIF(t10.Position = 'G', 1, 0) +
IIF(t11.Position = 'G', 1, 0) = 1
AND
IIF(t1.Position = 'D', 1, 0) + IIF(t2.Position = 'D', 1, 0) +
IIF(t3.Position = 'D', 1, 0) + IIF(t4.Position = 'D', 1, 0) +
IIF(t5.Position = 'D', 1, 0) + IIF(t6.Position = 'D', 1, 0) +
IIF(t7.Position = 'D', 1, 0) + IIF(t8.Position = 'D', 1, 0) +
IIF(t9.Position = 'D', 1, 0) + IIF(t10.Position = 'D', 1, 0) +
IIF(t11.Position = 'D', 1, 0) BETWEEN 3 AND 4
AND
IIF(t1.Position = 'M', 1, 0) + IIF(t2.Position = 'M', 1, 0) +
IIF(t3.Position = 'M', 1, 0) + IIF(t4.Position = 'M', 1, 0) +
IIF(t5.Position = 'M', 1, 0) + IIF(t6.Position = 'M', 1, 0) +
IIF(t7.Position = 'M', 1, 0) + IIF(t8.Position = 'M', 1, 0) +
IIF(t9.Position = 'M', 1, 0) + IIF(t10.Position = 'M', 1, 0) +
IIF(t11.Position = 'M', 1, 0) BETWEEN 3 AND 5
AND
IIF(t1.Position = 'F', 1, 0) + IIF(t2.Position = 'F', 1, 0) +
IIF(t3.Position = 'F', 1, 0) + IIF(t4.Position = 'F', 1, 0) +
IIF(t5.Position = 'F', 1, 0) + IIF(t6.Position = 'F', 1, 0) +
IIF(t7.Position = 'F', 1, 0) + IIF(t8.Position = 'F', 1, 0) +
IIF(t9.Position = 'F', 1, 0) + IIF(t10.Position = 'F', 1, 0) +
IIF(t11.Position = 'F', 1, 0) BETWEEN 1 AND 3
AND
(t1.Salary + t2.Salary + t3.Salary + t4.Salary + t5.Salary + t6.Salary +
t7.Salary + t8.Salary + t9.Salary + t10.Salary + t11.Salary) <= 100000000;
VBA Module
Next is the VBA module that runs an append and delete queries (to remove failed records that do not meet other constraints). Notice the for
loop at 50 iterations. Increase as needed, knowing there is quite a bit of choice sets with 11 players. Iterations are needed because above query may return zero depending on that random draw and the WHERE
logic conditioning. NOTE: First two delete queries require a union query to stack all players in first above query to better aggregate team counts, player counts, and team salary summation. See attached app.
Public Function IteratePicks()
Dim db As Database
Dim i As Integer
Set db = CurrentDb
For i = 1 To 50
db.Execute "INSERT INTO SoccerPicks SELECT * FROM SoccerTeamPicksQ", dbFailOnError
' DELETING TEAMS WITH DUPLICATE PLAYERS
db.Execute "DELETE FROM SoccerPicks" _
& " WHERE SoccerPicks.ID IN" _
& " (SELECT ID" _
& " FROM (SELECT SoccerPicksUnionQ.ID, SoccerPicksUnionQ.Player, Count(*) AS PlayerCount" _
& " FROM SoccerPicksUnionQ " _
& " GROUP BY SoccerPicksUnionQ.ID, SoccerPicksUnionQ.Player" _
& " HAVING Count(*) > 1) AS dT);", dbFailOnError
' DELETING TEAMS WITH TEAM PLAYER COUNT > 4
db.Execute "DELETE FROM SoccerPicks" _
& " WHERE SoccerPicks.ID IN" _
& " (SELECT ID AS MaxID" _
& " FROM (SELECT SoccerPicksUnionQ.ID, SoccerPicksUnionQ.Team, Count(*) AS TeamCount" _
& " FROM SoccerPicksUnionQ" _
& " GROUP BY SoccerPicksUnionQ.ID, SoccerPicksUnionQ.Team) AS dT" _
& " GROUP BY ID" _
& " HAVING Max(TeamCount) >= 4);", dbFailOnError
' DELETING TEAMS WITH SAME PLAYERS (I.E. SAME SALARY)
db.Execute "DELETE FROM SoccerPicks" _
& " WHERE ID IN" _
& " (SELECT ID AS MaxID" _
& " FROM SoccerPicks" _
& " WHERE TeamSalary IN" _
& " (SELECT sub.TeamSalary" _
& " FROM SoccerPicks sub" _
& " WHERE sub.ID < SoccerPicks.ID));", dbFailOnError
Next i
Set db = Nothing
MsgBox "Successfully completed!", vbInformation
End Function
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With