vbaexcelsolver

Optimization using Solver in Excel


I am trying to optimize three parameters in Excel to minimize the error between a experimental value and a theoretical value.

I use Solver for each parameter, one at a time, in a For loop.

I want to iterate this Solver For loop (loop inside a loop) until the error in the experimental value and the theoretical value is less than some target value.

My experimental value is $K25.
My theoretical value (calculated based on my model equations) is $J$25.
My parameters to be optimized are $C$4, $C$5, $C$6.

When I run the following VBA code my parameters in $C$4, $C$5, $C$6 do not change from their initial values.
The macro compiles.

Sub Macro3()
    Application.ScreenUpdating = False
    SolverReset
    Dim j As Integer
    For j = 1 To 100 Step 1
        If "$J$25" > "$K$25" Then
            Dim i As Integer, s As String
            For i = 4 To 6 Step 1
                s = Format(i, "0")
                SolverOk SetCell:="$J$25", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$" & s, Engine:= _
                  1, EngineDesc:="GRG Nonlinear"
                SolverOptions MaxTime:=0, Iterations:=1000000, Precision:=0.000001, Convergence _
                  :=0.00001, StepThru:=False, Scaling:=True, AssumeNonNeg:=True, Derivatives:=1
                SolverOptions PopulationSize:=100, RandomSeed:=0, MutationRate:=0.075, Multistart _
                  :=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
                  IntTolerance:=1, SolveWithout:=False, MaxTimeNoImp:=30
                SolverOk SetCell:="$J$25", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$" & s, Engine:= _
                  1, EngineDesc:="GRG Nonlinear"
                SolverSolve (True)
                SolverReset
            Next i
        End If
    Next j
    Application.ScreenUpdating = True
End Sub

Solution

  • I'm not really sure you need to do this in VBA, as what you're looking for is exactly what the Solver ought to do - modify a set of parameters so that something else is maximized/minimized!

    Therefore, all you need to do is to insert the formula =ABS(J25-K25) in another cell. This cell will display the delta between your experimental value and the theoretical value. Now set up your Solver so that it minimizes this cell by changing your three parameters - and you're done! (Note that you can provide more than one cell in the "By Changing Variable Cells" field!)

    In case you want to stick to your approach, here is the syntactical correct code. Note that I have not tested it - but only corrected the mistakes I could spot by looking through the code. It will hopefully be a good starting point. In fact, looking at this approach, I'm sure you'll end up with the wrong result, because each run optimizes only one variable - and you'll therefore never look into any effects that result from the combination of two or three parameters!

    Anyway, here's your code:

    Sub RunSolver()
        Dim j As Integer, i As Integer
    
        Application.ScreenUpdating = False
        SolverReset
    
        For j = 1 To 100
            Application.Statusbar = j & "/100"
            If Range("$J$25") > Range("$K$25") Then
                For i = 4 To 6
                    SolverOk SetCell:=Range("$J$25"), MaxMinVal:=2, ValueOf:=0, ByChange:=Range("$C$" & i), Engine:= _
                    1, EngineDesc:="GRG Nonlinear"
                    SolverOptions MaxTime:=0, Iterations:=1000000, Precision:=0.000001, Convergence _
                    :=0.00001, StepThru:=False, Scaling:=True, AssumeNonNeg:=True, Derivatives:=1
                    SolverOptions PopulationSize:=100, RandomSeed:=0, MutationRate:=0.075, Multistart _
                    :=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
                    IntTolerance:=1, SolveWithout:=False, MaxTimeNoImp:=30
                    SolverSolve (True)
                    SolverReset
                Next i
            End If
        Next j
    
        Application.StatusBar = False
        Application.ScreenUpdating = True
    End Sub