Listing all possible combinations with a few constraints

[tigre8989]

Hi all-

My question relates to fantasy football. In excel i have 5 columns (QB, RB, WR, TE, DEF). Each column will have 3-5 individual players. I want to create a list with every possible combination...Except there are a few wrinkles.. #1 there needs to be 2 RB, #2 there needs to be 3 WR, #3 there also needs to be a "FLEX" position which is one player from either the WR, RB or TE column, and #4 (and maybe the hardest) there is a price constraint. Ie each player will be assigned a price and the total "line up" must not exceed "x" price.

Therefore a final line up output should look like QB, RB, RB, WR, WR, WR, FLEX, TE, DEF where the total $ value should not equal more than "x"

Again, would really appreciate any guidance or even a start! Let me know if i should provide any further clarity.

 

[Eric W]

You haven't given me a lot to go on. You show me the code that works, and not what doesn't!

My first guess is that your sheet is not laid out like my example - possibly some empty cells in the columns. You can try replacing this part:

    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

with

    For r = 1 To 5
        Options(r, 0, 1) = Draft.Cells(Rows.Count, r * 3 - 2).End(xlUp).Row - 1
    Next r

but I suspect that if you do have spaces, you'll come up with more issues.

Try learning how to use the debug tools. You can single-step through the program with the F8 key. When you get to a line that you think should do something that's not happening, hover the mouse over the variables to see what they are and so figure out what's going on. F9 (set breakpoint) and F5 (run) are also useful.

 

[Rikko75]

Hi Eric,

Thanks a lot for the help. You was right. The issue was at columns level.

So I have a bit amended your code and I finish now with the table I needed

Starting from your table but with only 3 positions and finishing with teams composed of 1QB/2RB/2WR only
So it works perfectly!

Now I'm trying to reduce the amount of results by not generating combinaisons with more than 3 players from the same team within a 5 players team.
To do so, I have added a "Team" column close to the money one. Something like what you can see below, starting from your initial table. (done manually as I can't upload a pic lol)

QB 1 RB 2 WR 2
QB1 | 120 | TEAM3 | |RB1 | 110 | TEAM3 | |WR1 | 110 | TEAM3
QB1 | 100 | TEAM1 | |RB1 | 100 | TEAM1 | |WR1 | 105 | TEAM2
QB1 | 110 | TEAM2 | |RB1 | 110 | TEAM2 | |WR1 | 115 | TEAM1
QB1 | 115 | TEAM3 | |RB1 | 110 | TEAM2 | |WR1 | 115 | TEAM3
QB1 | 120 | TEAM1 | |RB1 | 120 | TEAM3 | |WR1 | 110 | TEAM2
QB1 | 120 | TEAM1 | |RB1 | 100 | TEAM1 | |WR1 | 105 | TEAM2
QB1 | 120 | TEAM2 | |RB1 | 110 | TEAM2 | |WR1 | 120 | TEAM2
QB1 | 120 | TEAM1 | |RB1 | 120 | TEAM3 | |WR1 | 130 | TEAM3
QB1 | 120 | TEAM2 | |RB1 | 110 | TEAM2 | |WR1 | 100 | TEAM1
...

Could you please help me one this one?

Thanks in advance and thanks a lot for what you've already shared with me!

Rikko

 

[Rikko75]

You haven't given me a lot to go on. You show me the code that works, and not what doesn't!

Hi!
Just found one issue
It seems that something is not allowing me to generate all the combinaisons.

Sub Fantasy()Dim Options(5, 9, 2), Draft As Worksheet, Teams As Worksheet
Dim RBList(100), WRList(100)
Dim RBMin As Byte, WRMin 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, 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")
    Budget = Draft.Cells(2, "Q")


Erase RBList, WRList
    Call Combos(RBMin, Left("12345", Options(2, 0, 1)), "", RBList)
    Call Combos(WRMin, Left("12345", Options(3, 0, 1)), "", WRList)
    
    Call CheckAndDisplay(Options, Budget, RBList, WRList, Teams)
    


End Sub
Public Sub CheckAndDisplay(Options, Budget, RBList, WRList, Teams)
Dim ResLine(1, 11), Payroll As Double
Dim QB As Byte, RB As Byte, WR As Byte




    For QB = 1 To Options(1, 0, 1)
        
            For RB = 1 To RBList(0)
                For WR = 1 To WRList(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)


                        
                        ' 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)
                        
                                     
                        
                        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 WR
            Next RB
    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

Maybe it is because of this part of the code:

Erase RBList, WRList    Call Combos(RBMin, Left("12345", Options(2, 0, 1)), "", RBList)
    Call Combos(WRMin, Left("12345", Options(3, 0, 1)), "", WRList)