Forum Discussion
Charlie Mitchell
Jan 23, 2018Copper Contributor
I need help with a list of a lists
Hello,
I am currently trying to use vba to check whether a solver solution has been found already and if so generate a new one. Below is my code. There are comments to explain what is going on.
Sub Button1_Click() ActiveSheet.Range("AL2:AL399").Value = 0 ActiveSheet.Range("BH2:BP399").Value = "" Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Dim i As Integer Dim j As Integer one = 1 two = 2 three = 3 four = 4 five = 5 thou = 50000 eight = 8 Dim variable As Integer min_cell = Range("BG6").Value max_cell = Range("BG7").Value gamer = Range("BG10").Value Dim players(1 To 200) As String 'here is the inner array Dim lineups(1 To 200) As Variant 'here is the outer array For i = 1 To 200 lineups(i) = players 'assigning the players array to each spot in the lineup array Next i If gamer = 0 Then spot = "BA3" accuracy = 0.00000001 ElseIf gamer = 1 Then spot = "BB3" accuracy = 0.001 End If lineup_quantity = Range("BG8").Value 'denotes how many different solutions the solver should generate Dim counter As Integer Dim count As Integer max_value = 1000 lineup_number = 1 'denotes the current lineup number For count = lineup_number To lineup_quantity 'running solver Dim positions(1 To 200) As String Dim cell_numbers(1 To 200) Dim game(1 To 200) As String track = 1 Worksheets("Predictions").Range("AI1:AI500").Copy Worksheets("Predictions").Range("DZ1:DZ500").PasteSpecial Paste:=xlPasteValues SolverReset solverok setcell:=spot, maxminval:=1, bychange:="AL" + CStr(min_cell) + ":AL" + CStr(max_cell), engine:=2 SolverOptions Precision:=accuracy solveradd cellref:="AL" + CStr(min_cell) + ":AL" + CStr(max_cell), relation:=5 solveradd cellref:=spot, relation:=1, formulatext:=max_value solveradd cellref:="BB6:BB10", relation:=3, formulatext:=one solveradd cellref:="BA2", relation:=1, formulatext:=thou solveradd cellref:="BB6:BB9", relation:=1, formulatext:=three solveradd cellref:="BB10", relation:=1, formulatext:=two solveradd cellref:="BA14", relation:=2, formulatext:=eight solveradd cellref:="BB11", relation:=1, formulatext:=four solveradd cellref:="BB16", relation:=1, formulatext:=four solveradd cellref:="BB12", relation:=1, formulatext:=five solversolve userfinish:=True If gamer = 0 Then 'ignore because gamer is not 0 max_value = Range(spot).Value - 0.001 Range("BP" + CStr(count + 1)).Value = max_value + 0.001 End If Range("BP" + CStr(count + 1)).Value = Range(spot).Value For counter = min_cell To max_cell If Range("AL" + CStr(counter)).Value = 1 Then players(track) = Range("B" + CStr(counter)).Value 'stores the result to of the solver and is working properly positions(track) = Range("A" + CStr(counter)).Value cell_numbers(track) = counter track = track + 1 End If Next counter For counter = 1 To lineup_number 'my attempt at comparing players to each array in lineups which is not working For i = 1 To 8 If lineups(counter)(i) <> players(i) Then GoTo hi End If Next i count = count - 1 'causes program to repeat current lineup GoTo Line hi: Next counter For i = 1 To 8 lineups(lineup_number)(i) = players(i) 'adding the current players as an array in lineups since they don't match any prior lineups Range("CN2").Value = lineups(lineup_number)(i) 'test to make sure this equals the line below which it does Range("CO2").Value = players(i) ''test to make sure this equals the line above which it does Next i For counter = 1 To 8 With ThisWorkbook.Worksheets("Predictions") game(counter) = Range("D" + CStr(cell_numbers(counter))).Value End With Next counter If game(1) = game(2) And game(1) = game(3) And game(1) = game(4) And game(1) = game(5) And game(1) = game(6) And game(1) = game(7) And game(1) = game(8) Then count = count - 1 GoTo Line End If For counter = 1 To 8 If positions(counter) = "PG" Then If Range("BH" + CStr(count + 1)).Value = "" Then Range("BH" + CStr(count + 1)).Value = players(counter) ElseIf Range("BM" + CStr(count + 1)).Value = "" Then Range("BM" + CStr(count + 1)).Value = players(counter) ElseIf Range("BO" + CStr(count + 1)).Value = "" Then Range("BO" + CStr(count + 1)).Value = players(counter) End If End If Next counter For counter = 1 To 8 If positions(counter) = "SG" Then If Range("BI" + CStr(count + 1)).Value = "" Then Range("BI" + CStr(count + 1)).Value = players(counter) ElseIf Range("BM" + CStr(count + 1)).Value = "" Then Range("BM" + CStr(count + 1)).Value = players(counter) ElseIf Range("BO" + CStr(count + 1)).Value = "" Then Range("BO" + CStr(count + 1)).Value = players(counter) End If End If Next counter For counter = 1 To 8 If positions(counter) = "SF" Then If Range("BJ" + CStr(count + 1)).Value = "" Then Range("BJ" + CStr(count + 1)).Value = players(counter) ElseIf Range("BN" + CStr(count + 1)).Value = "" Then Range("BN" + CStr(count + 1)).Value = players(counter) ElseIf Range("BO" + CStr(count + 1)).Value = "" Then Range("BO" + CStr(count + 1)).Value = players(counter) End If End If Next counter For counter = 1 To 8 If positions(counter) = "PF" Then If Range("BK" + CStr(count + 1)).Value = "" Then Range("BK" + CStr(count + 1)).Value = players(counter) ElseIf Range("BN" + CStr(count + 1)).Value = "" Then Range("BN" + CStr(count + 1)).Value = players(counter) ElseIf Range("BO" + CStr(count + 1)).Value = "" Then Range("BO" + CStr(count + 1)).Value = players(counter) End If End If Next counter For counter = 1 To 8 If positions(counter) = "C" Then If Range("BL" + CStr(count + 1)).Value = "" Then Range("BL" + CStr(count + 1)).Value = players(counter) ElseIf Range("BO" + CStr(count + 1)).Value = "" Then Range("BO" + CStr(count + 1)).Value = players(counter) End If End If Next counter For counter = 1 To 8 If positions(counter) = "PG/SG" Then If Range("BH" + CStr(count + 1)).Value = "" Then Range("BH" + CStr(count + 1)).Value = players(counter) ElseIf Range("BI" + CStr(count + 1)).Value = "" Then Range("BI" + CStr(count + 1)).Value = players(counter) ElseIf Range("BM" + CStr(count + 1)).Value = "" Then Range("BM" + CStr(count + 1)).Value = players(counter) ElseIf Range("BO" + CStr(count + 1)).Value = "" Then Range("BO" + CStr(count + 1)).Value = players(counter) End If End If Next counter For counter = 1 To 8 If positions(counter) = "PF/C" Then If Range("BL" + CStr(count + 1)).Value = "" Then Range("BL" + CStr(count + 1)).Value = players(counter) ElseIf Range("BK" + CStr(count + 1)).Value = "" Then Range("BK" + CStr(count + 1)).Value = players(counter) ElseIf Range("BN" + CStr(count + 1)).Value = "" Then Range("BN" + CStr(count + 1)).Value = players(counter) ElseIf Range("BO" + CStr(count + 1)).Value = "" Then Range("BO" + CStr(count + 1)).Value = players(counter) End If End If Next counter For counter = 1 To 8 If positions(counter) = "SF/PF" Then If Range("BK" + CStr(count + 1)).Value = "" Then Range("BK" + CStr(count + 1)).Value = players(counter) ElseIf Range("BJ" + CStr(count + 1)).Value = "" Then Range("BJ" + CStr(count + 1)).Value = players(counter) ElseIf Range("BN" + CStr(count + 1)).Value = "" Then Range("BN" + CStr(count + 1)).Value = players(counter) ElseIf Range("BO" + CStr(count + 1)).Value = "" Then Range("BO" + CStr(count + 1)).Value = players(counter) End If End If Next counter For counter = 1 To 8 If positions(counter) = "SG/SF" Then If Range("BI" + CStr(count + 1)).Value = "" Then Range("BI" + CStr(count + 1)).Value = players(counter) ElseIf Range("BJ" + CStr(count + 1)).Value = "" Then Range("BJ" + CStr(count + 1)).Value = players(counter) ElseIf Range("BM" + CStr(count + 1)).Value = "" Then Range("BM" + CStr(count + 1)).Value = players(counter) ElseIf Range("BN" + CStr(count + 1)).Value = "" Then Range("BN" + CStr(count + 1)).Value = players(counter) ElseIf Range("BO" + CStr(count + 1)).Value = "" Then Range("BO" + CStr(count + 1)).Value = players(counter) End If End If Next counter For counter = 1 To 8 If positions(counter) = "PG/SF" Then If Range("BH" + CStr(count + 1)).Value = "" Then Range("BH" + CStr(count + 1)).Value = players(counter) ElseIf Range("BJ" + CStr(count + 1)).Value = "" Then Range("BJ" + CStr(count + 1)).Value = players(counter) ElseIf Range("BM" + CStr(count + 1)).Value = "" Then Range("BM" + CStr(count + 1)).Value = players(counter) ElseIf Range("BN" + CStr(count + 1)).Value = "" Then Range("BN" + CStr(count + 1)).Value = players(counter) ElseIf Range("BO" + CStr(count + 1)).Value = "" Then Range("BO" + CStr(count + 1)).Value = players(counter) End If End If Next counter Line: Worksheets("Predictions").UsedRange.Columns("AI:AI").Calculate Next count Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
I am still getting duplicates when I run it for a large number of lineups like 40. Any help would be greatly appreciated.
No RepliesBe the first to reply