The code I'm interested in understanding was provided by a MrExcel member (Stephen Comb) a few years ago. The code was designed to assist me in identifying all combination of players along with tallying various stats as tennis court assignments are made. As designed, the code worked great. But I've since tried to go beyond working to fill one Court and now am attempting to fill up to 5 Courts. However, due to my lack of understanding regarding how the code works, I may have implemented the code incorrectly and would appreciate some feedback with regards to if it will work as I had hoped or if other tweaks may need to be implemented. First, here is the code:
Sub PlayerCombo()
'
' DO NOT MESS WITH THIS SUBROUTINE
'
' This code was provided by Stephen Comb via the Mr. Excel Forum
' Based on the number of players selected to play ("N"), the code performs three major functions
' 1. Establishes all potential combinations,
' 2. Calculates the "total" value of % played between ALL players
' 3. Sorts players in ascending order by calculated value.
'
Dim lCombinations() As Long, lPairs() As Long, lNumbers() As Long, N As Long, r As Long, i As Long, j As Long, lOffset As Long
Dim dScores() As Double
Dim inarray As Variant, NameList As Variant
' nPlayers is set in TeamSelection subroutines Example: "nPlayers" will equal either 20, 16, 12, 8 or 4 [Identifies how many players are to be used to determine combinations]
N = nPlayers
r = 4
lOffset = 7 'Col A --> Col H for scores
lPairs = GetCombinations(r, 2)
If UBound(lPairs) > lOffset Then
MsgBox "You need a bigger offset!"
Exit Sub
End If
' myNameList is set in TeamSelection subroutines Example: myNameList = Sheets("CommonData").Range("$E$3:$X$3").Value2 [Places only the Player Numbers into NAMELIST]
'
NameList = myNameList
lCombinations = GetCombinations(N, r)
ReDim dScores(1 To UBound(lCombinations), 1 To UBound(lPairs))
ReDim lNumbers(1 To UBound(lCombinations), 1 To r)
inarray = Sheets("CommonData").Range("E5:X24").Value2
For i = 1 To UBound(lCombinations)
For j = 1 To UBound(lPairs)
dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2)))
Next j
For j = 1 To r
lNumbers(i, j) = NameList(1, lCombinations(i, j))
Next j
Next i
'####################################################################################################################################
' NOTE: wsName is originally set in TeamSelection to Courts1 but will be reset for as many times as an additional court is required
'####################################################################################################################################
With Worksheets(wsName).Range("C7").Resize(UBound(lCombinations)) 'modify sheet name as appropriate
.Resize(, r).Value = lNumbers
.Offset(, lOffset).Resize(, UBound(lPairs)).Value = dScores
.Offset(, lOffset + UBound(lPairs)).FormulaR1C1 = "=SUM(RC[-" & UBound(lPairs) & "]:RC[-1])"
.Resize(, lOffset + UBound(lPairs) + 1).Sort Key1:=.Columns(lOffset + UBound(lPairs) + 1), Order1:=xlAscending
End With
End Sub
Here is an extract from the CommonData worksheet that contains the data (ranges) that's being used by the above program:
As an FYI, Column "B" contains Player Numbers sorted in ascending order from top to bottom. Also, Row "3" contains Player Numbers sorted in ascending order from Left to Right.
In this example, there are a total of 20 players because the intent is to fill 5 courts (4 players per court x 5 courts = 20 players). The code above uses the player numbers provided in row 25 and I believe works just fine as the program runs thru to fill the first court with 4 players.
My question and concern come up when I try to examine options for the second Court. As you can see below, row 25 has 4 less player numbers because 1, 8, 19 and 23 have been removed and inserted into Court 1 and the rest of the player numbers have been sorted in ascending order from Left to Right in preparation of the next run through the PlayerCombo() subroutine.
My questions are the following:
Sub PlayerCombo()
'
' DO NOT MESS WITH THIS SUBROUTINE
'
' This code was provided by Stephen Comb via the Mr. Excel Forum
' Based on the number of players selected to play ("N"), the code performs three major functions
' 1. Establishes all potential combinations,
' 2. Calculates the "total" value of % played between ALL players
' 3. Sorts players in ascending order by calculated value.
'
Dim lCombinations() As Long, lPairs() As Long, lNumbers() As Long, N As Long, r As Long, i As Long, j As Long, lOffset As Long
Dim dScores() As Double
Dim inarray As Variant, NameList As Variant
' nPlayers is set in TeamSelection subroutines Example: "nPlayers" will equal either 20, 16, 12, 8 or 4 [Identifies how many players are to be used to determine combinations]
N = nPlayers
r = 4
lOffset = 7 'Col A --> Col H for scores
lPairs = GetCombinations(r, 2)
If UBound(lPairs) > lOffset Then
MsgBox "You need a bigger offset!"
Exit Sub
End If
' myNameList is set in TeamSelection subroutines Example: myNameList = Sheets("CommonData").Range("$E$3:$X$3").Value2 [Places only the Player Numbers into NAMELIST]
'
NameList = myNameList
lCombinations = GetCombinations(N, r)
ReDim dScores(1 To UBound(lCombinations), 1 To UBound(lPairs))
ReDim lNumbers(1 To UBound(lCombinations), 1 To r)
inarray = Sheets("CommonData").Range("E5:X24").Value2
For i = 1 To UBound(lCombinations)
For j = 1 To UBound(lPairs)
dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2)))
Next j
For j = 1 To r
lNumbers(i, j) = NameList(1, lCombinations(i, j))
Next j
Next i
'####################################################################################################################################
' NOTE: wsName is originally set in TeamSelection to Courts1 but will be reset for as many times as an additional court is required
'####################################################################################################################################
With Worksheets(wsName).Range("C7").Resize(UBound(lCombinations)) 'modify sheet name as appropriate
.Resize(, r).Value = lNumbers
.Offset(, lOffset).Resize(, UBound(lPairs)).Value = dScores
.Offset(, lOffset + UBound(lPairs)).FormulaR1C1 = "=SUM(RC[-" & UBound(lPairs) & "]:RC[-1])"
.Resize(, lOffset + UBound(lPairs) + 1).Sort Key1:=.Columns(lOffset + UBound(lPairs) + 1), Order1:=xlAscending
End With
End Sub
Here is an extract from the CommonData worksheet that contains the data (ranges) that's being used by the above program:
As an FYI, Column "B" contains Player Numbers sorted in ascending order from top to bottom. Also, Row "3" contains Player Numbers sorted in ascending order from Left to Right.
In this example, there are a total of 20 players because the intent is to fill 5 courts (4 players per court x 5 courts = 20 players). The code above uses the player numbers provided in row 25 and I believe works just fine as the program runs thru to fill the first court with 4 players.
My question and concern come up when I try to examine options for the second Court. As you can see below, row 25 has 4 less player numbers because 1, 8, 19 and 23 have been removed and inserted into Court 1 and the rest of the player numbers have been sorted in ascending order from Left to Right in preparation of the next run through the PlayerCombo() subroutine.
My questions are the following:
- By shortening the list of players in Row 25 and leaving the original chart unchanged (E5:X24) does that impact how the PlayerCombo subroutine examines the data and comes up with the various counts for the "scores" and "numbers" or, does the PlayerCombo subroutine able to dynamically examine the entire chart and come up with the appropriate totals?
- Or, must I figure out a way to compact the chart by removing those players that have been selected to be placed on Court 1? This would be something I would not know how to easily do.
