Excel Solver not going through showRef (showTrial function) even though stepThru set to true

[miriza]

Hi!

I am using Solver to calibrate a model and I am setting

 SolverOptions StepThru:=True

and then having solversolve call the "ShowTrial" function as showRef

 answer = SolverSolve(False, "ShowTrial")

So this function that is defined below on my code should be called on every trial of the Solver, but what I'm finding is that it's only being called when I reach a limit (maxiterations or maxtime) and not on every iteration. Help? I want to be able to modify ShowTrial eventually so that it writes out the parameter values and objective function after each iteration, but so far it's not even getting called at every iteration

Thanks!

Sub Calibrate_Solver()


  'Get Worksheets

  Call Get_Worksheets

 

  'Check to see if all user input parameters exist

  Call Check_Input_Data

 

  'Unprotect all Sheets

  Call Unprotect_All

 

  'Get Simulation Parameters

  Call Get_Simulation_Variables

 

  r = 1

  print_count = 1

  'Get Precip Data

  Set wb = Workbooks.Open(ActiveWorkbook.Path & "\Precip_SubBasins_Real_" & r & "_1000.csv")

  Call Import_Precip

  'Get ET Data (MI)

  Workbooks.Open Filename:=ActiveWorkbook.Path & "\ET_SubBasins_" & r & ".csv"

  Call Import_ET

  'Get Historical Data (MI)

  Call Import_Historical

 

  'Set mWB = ActiveWorkbook

  'MsgBox "Active Sheet" & ActiveSheet.Name & "here1"

 

  'Set wsOpt = mWB.Sheets("Optim_Results")

  wsOpt.Activate

  'MsgBox "Active Sheet" & ActiveSheet.Name & "here2"

 

  DataAddress = "$R$2:$R$14966"

  ParaAddress = "$F$3:$K$3"

  objStr = "objfunc(" + DataAddress + "," + ParaAddress + ")"

  'MsgBox "Active Sheet" & ActiveSheet.Name & "here3"

 

  wsOpt.Range("$C$3") = "=" + objStr 'SSQ

 

  wsOpt.Activate

  'Call setparams

 

  SolverReset

  SolverOk SetCell:="$C$3", MaxMinVal:=2, ByChange:="$F$3:$K$3", Engine:=3 'SSQ

    SolverAdd CellRef:="$F$3:$K$3", Relation:=3, FormulaText:="$F$10:$K$10"

    SolverAdd CellRef:="$F$3:$K$3", Relation:=1, FormulaText:="$F$11:$K$11"

    SolverOptions MaxTime:=6000, Iterations:=100, Precision:=0.000001, AssumeLinear _

    :=False, Estimates:=2, Derivatives:=1, SearchOption:=1, _

    IntTolerance:=5, Scaling:=True, Convergence:=0.0001, AssumeNonNeg:=True

    SolverOptions StepThru:=True

 

    answer = SolverSolve(False, "ShowTrial")

    MsgBox "Solver Done, answer=" & CStr(answer)

 

End Sub

 

Function ShowTrial(Reason As Integer)

  MsgBox Reason & ", F3=" & CStr(wsOpt.Range("F3")) & ",G3=" & CStr(wsOpt.Range("G3")) _

  & ",H3=" & CStr(wsOpt.Range("H3")) & ",I3=" & CStr(wsOpt.Range("I3")) _

  & ",J3=" & CStr(wsOpt.Range("J3")) & ",K3=" & CStr(wsOpt.Range("K3")) & ",C3=" & CStr(wsOpt.Range("C3"))

  ShowTrial = False

End Function

 




Function objfunc(range1 As Range, range2 As Range)

' Function objfunc(range1 As Range, opt As Integer, p1 As Single)

' range1 contains the array of data to compare with model results in the calibration process

' note also that range2 is a dummy range which must encompass the complete potential list of parameters

'which are being varied for the optimization - this is a quirk of solver, apparently

 

'Dim p1 As Single

 

'c1 = range1.Count

'p1 = 1#

 

Call Stochastic_Simulation

 

ssq = 0

i = 0

For Each c In range1 'model

i = i + 1

 

If IsNumeric(c.Value) And Not IsEmpty(c.Value) Then ssq = ssq + (c.Value - FECQ_Print(i, 1)) ^ 2

 

Next c

 

'ssq = WorksheetFunction.SumXMY2(range1, FECQ_Print)

objfunc = ssq

 

  MsgBox "F3=" & CStr(wsOpt.Range("F3")) & ",G3=" & CStr(wsOpt.Range("G3")) _

  & ",H3=" & CStr(wsOpt.Range("H3")) & ",I3=" & CStr(wsOpt.Range("I3")) _

  & ",J3=" & CStr(wsOpt.Range("J3")) & ",K3=" & CStr(wsOpt.Range("K3")) & ",ssq=" & CStr(ssq)

End Function

Sub Stochastic_Simulation()

'My model here

End Sub