Solver VBA - Works but just one problem...

[Mightyginger]

I have set up a problem in my spreadsheet and it's solving the problem for each column with each column being a different historic date in time where the data was slightly different, so it just loops through. The problem is this, despite having set SolverFinish KeepFinal:=1 in my code I still get a window coming up sometimes saying "The maximum time limit was reached. Continue anyway?" How can I supress this and tell it just to Stop?

Sub solve_all()
Dim columnno As Integer
Dim row As Integer
Dim longstrg As String
Dim tempsolve As String
Dim temprange As String
columnno = 105
row = 15
Do Until columnno = 107
'this will take forever
'set column to have average
Do Until row = 26
longstrg = "=allaverage(R58C94:R409C" & columnno & _
",R" & (row - 11) & "C94,R" & (row - 10) & "C94,R3C" & columnno & ")"
Sheet1.Cells(row, columnno).Formula = longstrg
row = row + 1
Loop
'solve
tempsolve = "R37C" & columnno
temprange = "R47C" & columnno & ":R56C" & columnno
SolverReset
SolverOk SetCell:=tempsolve, MaxMinVal:=3, ValueOf:="0", ByChange:=temprange

SolverSolve userFinish:=False
'End and keep results
SolverFinish KeepFinal:=1
'copy and paste special
Sheet1.Range(Cells(15, columnno), Cells(25, columnno)).Copy
Sheet1.Range(Cells(15, columnno), Cells(25, columnno)).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
columnno = columnno + 1
row = 15
Loop

End Sub

 

[Mightyginger]

Also, I shoudl add it also - once it's solved the problem prompts me if I want to keep the solution. I thought SolverFinish supressed this?

Thanks,


Neil.

 

[Mightyginger]

Thanks for looking but I've solved it. Just for anyone with the same problem the following code worked...

Sub solve_all()
Dim Results
Dim columnno As Integer
Dim row As Integer
Dim longstrg As String
Dim tempsolve As String
Dim temprange As String
columnno = 97
row = 15
Do Until columnno = 198
'set column to have average
Do Until row = 26
longstrg = "=allaverage(R58C94:R409C" & columnno & _
",R" & (row - 11) & "C94,R" & (row - 10) & "C94,R3C" & columnno & ")"
Sheet1.Cells(row, columnno).Formula = longstrg
row = row + 1
Loop
'solve
tempsolve = "R37C" & columnno
temprange = "R47C" & columnno & ":R56C" & columnno
SolverReset
SolverOk SetCell:=tempsolve, MaxMinVal:=3, ValueOf:="0", ByChange:=temprange
SolverOptions Iterations:=20 'Your Value here
Results = SolverSolve(True, "SolverStepThru")
'copy and paste special
Select Case Results
Case 0, 1, 2
' Solver found a solution.
SolverFinish 1
Case 3, 10
SolverFinish 1 ' Keep Results
End Select

Sheet1.Range(Cells(15, columnno), Cells(25, columnno)).Copy
Sheet1.Range(Cells(15, columnno), Cells(25, columnno)).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
columnno = columnno + 1
row = 15
Loop

End Sub

Function SolverStepThru(Reason As Integer)
Select Case Reason
Case 2, 3
SolverStepThru = True ' Will Abort
End Select
End Function