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