Accepting solver solutions automatically under VBA

T

tkpmep

I have a loop that changes some parameters with each loop, and then
sets up and solves an optimization problem. The results from each run
are stored on a separate sheet. I sometimes find that a dailog box
appears saying that the iteration limit has been reached. In such
cases, I am more than happy to acccept the solution and to just go on
to the next iteration, but I want this done automatically with no
need for human intervention. The userFinish option for SolverSolve
allows me to accept the final solution without any need for human
intervention; is there a corresponding way in which to suppress
warning or error messages and accept the current solution as well? My
code follows - thanks in advance for your assistance.

Sincerely

Thomas Philips

SolverReset
SOLVERAdd CellRef:="$C$1:$F$1", Relation:=1, FormulaText:="1"
SOLVERAdd CellRef:="$C$1:$F$1", Relation:=3, FormulaText:="0"
SOLVERAdd CellRef:="$B$1", Relation:=2, FormulaText:="1"

SolverOk SetCell:="$U$7", MaxMinVal:=2, ValueOf:="0", ByChange:="$C
$1:$F$1"
SolverOptions MaxTime:=100, Iterations:=10000, Precision:=0.0000001, _
AssumeLinear:=False, StepThru:=False,
Estimates:=2, _
Derivatives:=1, SearchOption:=1, IntTolerance:=1,
Scaling:=True, _
Convergence:=0.000001, AssumeNonNeg:=True

SolverSolve userFinish:=True
 
J

jasontferrell

You may have to use something like SendKeys (yes, I know this isn't
the popular thing to do). I don't have the ability to create it here,
but maybe you can modify this to do what you want. It uses the
sendmessage api call and finds a child window named "File Download",
then sends a click to the button named "button".
/*snip from main code*/
If Not WaitForBox("File Download") Then
MsgBox "Download box not displayed"
Exit Sub
End If
Sleep 500: SendClick "File Download", "&Save": Sleep
500
/*supporting routines*/
Public Sub SendClick(sTitle As String, sButton As String)
Dim hWnd As Long, hBtn As Long, lRes As Long
hWnd = FindWindow(vbNullString, sTitle)
If hWnd > 0 Then
hBtn = FindWindowEx(hWnd, ByVal 0&, "Button", sButton)
If hBtn > 0 Then
SetForegroundWindow hBtn
SetActiveWindow hBtn
Sleep 1000
SendMessage hBtn, BM_CLICK, 0, ByVal 0&
End If
Else
MsgBox "Failed to send the click."
End If
End Sub
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As
Long
Public Declare Function FindWindowEx Lib "user32" Alias
"FindWindowExA" _
(ByVal hWnd As Long, hWndC As Long, ByVal lpClassName As String,
ByVal lpWindowName As String) As Long
Public Declare Function SetActiveWindow Lib "user32.dll" (ByVal hWnd
As Long) As Long
Public Declare Function SetForegroundWindow Lib "user32.dll" (ByVal
hWnd As Long) As Boolean
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function SendMessage Lib "user32" Alias
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam
As Long, lParam As Any) As Long
 
T

Tim Williams

Try

Application.DisplayAlerts = False

Set it back to True after your code has run.

Tim
 
D

Dana DeLouis

SOLVERAdd CellRef:="$B$1", Relation:=2, FormulaText:="1"
ByChange:="$C$1:$F$1"
Iterations:=10000

A little off topic, but your setup looks similar to other problems I
have seen.
I am totally guessing here, but my guess is that B1 has =Sum(C1:F1) and
you want the sum to total 100%.

When C1,D1,E1 all have values, Solver will try for a long time (I'm
looking at your Iterations = 1000) to calculate what F1 should be to get
value of 1 in your constraints.

Consider changing F1 from a changing cell to a formula = 1-Sum(C1:E1)
Now, Solver changes 3 cells, and your 4th one is calculated
automatically. The added benefit is that this is an exact "1" vs an
approximate value from Solver based on precision.

Again, please ignore this if it doesn't apply. I'm only guessing here.

= = =
Dana DeLouis
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top