Sub Fantasy()
Dim Options(5, 9, 2), Draft As Worksheet, Teams As Worksheet
Dim RBList(100), WRList(100), TEList(100)
Dim RBMin As Byte, WRMin As Byte, TEMin As Byte
Dim Budget As Double
Set Draft = Sheets("Sheet3")
Set Teams = Sheets("Sheet4")
Teams.Cells.ClearContents
Teams.Cells(1, 1) = "QB"
Teams.Cells(1, 2) = "RB"
Teams.Cells(1, 3) = "RB"
Teams.Cells(1, 4) = "WR"
Teams.Cells(1, 5) = "WR"
Teams.Cells(1, 6) = "WR"
Teams.Cells(1, 7) = "TE"
Teams.Cells(1, 8) = "DEF"
Teams.Cells(1, 9) = "FLEX"
Teams.Cells(1, 11) = "Payroll"
Options(1, 0, 1) = Draft.Columns(1).Find("").Row - 2
Options(2, 0, 1) = Draft.Columns(4).Find("").Row - 2
Options(3, 0, 1) = Draft.Columns(7).Find("").Row - 2
Options(4, 0, 1) = Draft.Columns(10).Find("").Row - 2
Options(5, 0, 1) = Draft.Columns(13).Find("").Row - 2
For r = 2 To 10
Options(1, r - 1, 1) = Draft.Cells(r, 1)
Options(1, r - 1, 2) = Draft.Cells(r, 2)
Options(2, r - 1, 1) = Draft.Cells(r, 4)
Options(2, r - 1, 2) = Draft.Cells(r, 5)
Options(3, r - 1, 1) = Draft.Cells(r, 7)
Options(3, r - 1, 2) = Draft.Cells(r, 8)
Options(4, r - 1, 1) = Draft.Cells(r, 10)
Options(4, r - 1, 2) = Draft.Cells(r, 11)
Options(5, r - 1, 1) = Draft.Cells(r, 13)
Options(5, r - 1, 2) = Draft.Cells(r, 14)
Next r
RBMin = Draft.Cells(1, "E")
WRMin = Draft.Cells(1, "H")
TEMin = Draft.Cells(1, "K")
Budget = Draft.Cells(2, "Q")
' Case 1 - The Flex player is RB
Erase RBList, WRList, TEList
Call Combos(RBMin + 1, Left("123456789", Options(2, 0, 1)), "", RBList)
Call Combos(WRMin, Left("123456789", Options(3, 0, 1)), "", WRList)
Call Combos(TEMin, Left("123456789", Options(4, 0, 1)), "", TEList)
Call CheckAndDisplay(Options, Budget, RBList, WRList, TEList, 1, Teams)
' Case 2 - The Flex player is WR
Erase RBList, WRList, TEList
Call Combos(RBMin, Left("123456789", Options(2, 0, 1)), "", RBList)
Call Combos(WRMin + 1, Left("123456789", Options(3, 0, 1)), "", WRList)
Call Combos(TEMin, Left("123456789", Options(3, 0, 1)), "", TEList)
Call CheckAndDisplay(Options, Budget, RBList, WRList, TEList, 2, Teams)
' Case 3 - The Flex player is TE
Erase RBList, WRList, TEList
Call Combos(RBMin, Left("123456789", Options(2, 0, 1)), "", RBList)
Call Combos(WRMin, Left("123456789", Options(3, 0, 1)), "", WRList)
Call Combos(TEMin + 1, Left("123456789", Options(4, 0, 1)), "", TEList)
Call CheckAndDisplay(Options, Budget, RBList, WRList, TEList, 3, Teams)
End Sub
Public Sub CheckAndDisplay(Options, Budget, RBList, WRList, TEList, MyCase, Teams)
Dim ResLine(1, 11), Payroll As Double
Dim QB As Byte, RB As Byte, WR As Byte, TE As Byte, DF As Byte
For QB = 1 To Options(1, 0, 1)
For DF = 1 To Options(5, 0, 1)
For RB = 1 To RBList(0)
For WR = 1 To WRList(0)
For TE = 1 To TEList(0)
'QB
ResLine(1, 1) = Options(1, QB, 1)
Payroll = Options(1, QB, 2)
' RB
ResLine(1, 2) = Options(2, Mid(RBList(RB), 1, 1), 1)
Payroll = Payroll + Options(2, Mid(RBList(RB), 1, 1), 2)
ResLine(1, 3) = Options(2, Mid(RBList(RB), 2, 1), 1)
Payroll = Payroll + Options(2, Mid(RBList(RB), 2, 1), 2)
If MyCase = 1 Then
ResLine(1, 9) = Options(2, Mid(RBList(RB), 3, 1), 1)
Payroll = Payroll + Options(2, Mid(RBList(RB), 3, 1), 2)
End If
' WR
ResLine(1, 4) = Options(3, Mid(WRList(WR), 1, 1), 1)
Payroll = Payroll + Options(3, Mid(WRList(WR), 1, 1), 2)
ResLine(1, 5) = Options(3, Mid(WRList(WR), 2, 1), 1)
Payroll = Payroll + Options(3, Mid(WRList(WR), 2, 1), 2)
ResLine(1, 6) = Options(3, Mid(WRList(WR), 3, 1), 1)
Payroll = Payroll + Options(3, Mid(WRList(WR), 3, 1), 2)
If MyCase = 2 Then
ResLine(1, 9) = Options(3, Mid(WRList(WR), 4, 1), 1)
Payroll = Payroll + Options(3, Mid(WRList(WR), 4, 1), 2)
End If
' TE
ResLine(1, 7) = Options(4, Mid(TEList(TE), 1, 1), 1)
Payroll = Payroll + Options(4, Mid(TEList(TE), 1, 1), 2)
If MyCase = 3 Then
ResLine(1, 9) = Options(4, Mid(TEList(TE), 2, 1), 1)
Payroll = Payroll + Options(4, Mid(TEList(TE), 2, 1), 2)
End If
' DEF
ResLine(1, 8) = Options(5, DF, 1)
Payroll = Payroll + Options(5, DF, 2)
If Payroll < Budget Then
ResLine(1, 11) = Payroll
r = Teams.Columns(1).Find("").Row
For c = 1 To 11
Teams.Cells(r, c) = ResLine(1, c)
Next c
End If
Next TE
Next WR
Next RB
Next DF
Next QB
End Sub
Public Sub Combos(TotCount, ListIn, ListOut, ResultAr)
If Len(ListOut) = TotCount Then
a = ResultAr(0)
a = a + 1
ResultAr(a) = ListOut
ResultAr(0) = a
Exit Sub
End If
For i = 1 To Len(ListIn) + Len(ListOut) + 1 - TotCount
Call Combos(TotCount, Mid(ListIn, i + 1), ListOut & Mid(ListIn, i, 1), ResultAr)
Next i
End Sub