I have been running an excel Macro for a while now and keep running into the same issue with it. After multiple runs of the macro on a worksheet the performance eventually slows down dramatically. The code runs the Excel solver function on a bunch of different design points. when first created it will run 600 points in 3-4 minutes. Once it slows down it takes upwards of 30 minutes. The slowdown doesn't happen gradually. Rather one day I will run the code and it will be fast and the next day it will be slow.

I believe it is a worksheet issue more than a VBA issue because I can re-create the sheet (even within the same workbook) and it will run fast again. If I copy the cells and VBA code directly to a new sheet nothing changes. However, copy and paste special the cells as values, copy the VBA code, and manually re-insert the formulas in the appropriate cells it will run fast again for a while.

Any help that would eliminate the need for me to copy to a new sheet would be much appreciated.

Thanks
DKlutzke


Sub Macro_2_Pass_Fuel_Solver()

    Dim i As Long
    Application.ScreenUpdating = False
    i = 6
    Do Until IsEmpty(Range("A" & i))

        SolverReset

        SolverAdd CellRef:=Range("I" & i), Relation:=1, FormulaText:="$I$2" 'sets maximum fuel vol tank 1
        SolverAdd CellRef:=Range("J" & i), Relation:=1, FormulaText:="$J$2" 'sets maximum fuel vol tank 2
        SolverAdd CellRef:=Range("K" & i), Relation:=1, FormulaText:="$K$2" 'sets maximum fuel vol tank 3
        SolverAdd CellRef:=Range("I" & i), Relation:=3, FormulaText:="$I$1" 'sets Min fuel vol tank 1
        SolverAdd CellRef:=Range("J" & i), Relation:=3, FormulaText:="$J$1" 'sets Min fuel vol tank 2
        SolverAdd CellRef:=Range("K" & i), Relation:=3, FormulaText:="$K$1" 'sets Min fuel vol tank 3
        SolverAdd CellRef:=Range("W" & i), Relation:=2, FormulaText:=0 'says sum of three tanks must equal total fuel vol
        SolverOptions MaxTime:=1000, Iterations:=1000, Precision:=0.000001, AssumeLinear:=False, StepThru:=False, Estimates:=1, Derivatives:=1, SearchOption:=1, IntTolerance:=2, Scaling:=False, Convergence:=0.0001, AssumeNonNeg:=True
        SolverOk SetCell:=Range("v" & i), MaxMinVal:=3, ValueOf:="0", ByChange:=Range("I" & i & ":J" & i & ":K" & i)
        
        SolverSolve userFinish:=True
        i = i + 1
    Loop
    
    Application.ScreenUpdating = True
End Sub