I need help with a list of a lists

Copper Contributor

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.

0 Replies