Dim comboMatrix() As Variant
Dim count As Long
Sub teamSort()
Dim players() As Variant
Dim points() As Variant
Dim numComb As Long
Dim lRow As Integer, totalPoints As Integer, limitPoint As Integer, c As Integer
limitPoint = 2375
numComb = 5
lRow = Cells(Rows.count, 1).End(xlUp).Row
ReDim players(lRow)
ReDim points(lRow)
For i = 1 To lRow
players(i) = Cells(i, 1).Value
points(i) = Cells(i, 2).Value
Next
Call CombosNoRep(players, numComb)
c = 4
For i = 1 To count - 1
totalPoints = 0
For j = 1 To numComb
For k = 1 To lRow
If players(k) = comboMatrix(i, j) Then
totalPoints = totalPoints + points(k)
End If
Next
Next
If totalPoints <= limitPoint Then
For r = 1 To numComb
Cells(r, c).Value = comboMatrix(i, r)
Cells(r, c + 1).Value = points(r)
Next
Cells(r, c ).Value = "TOTAL"
Cells(r, c + 1).Value = totalPoints
c = c + 3
End If
Next
End Sub
Sub CombosNoRep(ByRef v() As Variant, r As Long)
Dim i As Long, k As Long, z() As Variant
Dim numRows As Long, numIter As Long, n As Long
count = 1
n = UBound(v)
numRows = nChooseK(n, r)
ReDim z(1 To r)
ReDim comboMatrix(1 To numRows, 1 To r)
For i = 1 To r: z(i) = i: Next i
Do While (count <= numRows)
numIter = n - z(r) + 1
For i = 1 To numIter
For k = 1 To r: comboMatrix(count, k) = v(z(k)): Next k
count = count + 1
z(r) = z(r) + 1
Next i
For i = r - 1 To 1 Step -1
If Not (z(i) = (n - r + i)) Then
z(i) = z(i) + 1
For k = (i + 1) To r: z(k) = z(k - 1) + 1: Next k
Exit For
End If
Next i
Loop
End Sub
Function nChooseK(n As Long, k As Long) As Long
Dim temp As Double, i As Long
temp = 1
For i = 1 To k: temp = temp * (n - k + i) / i: Next i
nChooseK = CLng(temp)
End Function