Using Excel Solver multiple times with macros

[Guest]

Is there a way to use dummy indices in macros in order to invoke Solver
multiple times? I want to solve for the value in column D by changing the
values in columns A and B, based on the value in Column C being constrained.
Rather than having cell references be definitive (i.e. "$A$1"), I want to put
the solver functions in a loop (An), where n varies up to 800, so that I can
invoke solver on 800 lines of data.

 

[Guest]

Hi Barry,
Each row in the sheet is a different problem to be solved, isn't it?
You can run Solver automatically multiple times using a macro. First you
need to set a reference to it in the vba editor: menu Tools > References,
select 'Solver'.
Then use code similar to:

'-------------------------------------------
Sub solveAll()
Dim cellChange As Range
Dim cellGoal As Range
Dim cellConstraint As Range

Set cellChange = ActiveSheet.Range("A2:B2")
Set cellGoal = ActiveSheet.Range("d2")
Set cellConstraint = ActiveSheet.Range("c2")

Do '********* LOOP & SOLVE ***************
SolverReset
SolverOptions Precision:=0.001
SolverOK SetCell:=cellGoal.Address(True, True), _
MaxMinVal:=1, ByChange:=cellChange.Address(True, True)
SolverAdd CellRef:=cellConstraint.Address(True, True), _
Relation:=1, FormulaText:=100
Solver.SolverSolve UserFinish:=True

Set cellChange = cellChange.Offset(1, 0)
Set cellGoal = cellGoal.Offset(1, 0)
Set cellConstraint = cellConstraint.Offset(1, 0)

Loop While Trim(cellGoal.Text) <> "" 'until goal cell is empty
End Sub
'---------------------------------------------

Regards,
Sébastien

 

[cefd]

Here is what i came up with to solve the same problem... the (True,True) term
was not working for me....


Sub solveAlls()

MsgBox "SolveAlls"

Dim cellChange

Dim cellGoal

Dim Nmm

Set cellChange = ActiveSheet.Application.InputBox("Please the 1st cell you
wish to vary", , , , , , , 8)
'Following cells that want to be varied must be in teh range of Nmm... and
below "cellChange"

Set cellGoal = ActiveSheet.Application.InputBox("Corressponding Cell to
Zero", , , , , , , 8)

Set Nmm = ActiveSheet.Application.InputBox("Range", , , , , , , 8)
'If 8 rows of data need to be solved for... this would be 8



Dim j As Integer

j = Nmm.Rows.Count

MsgBox "j = " & j









For i = 1 To j

MsgBox "i=" & i
SolverReset

SolverOK SetCell:=cellGoal.Address, MaxMinVal:=3, ValueOf:="0",
ByChange:=cellChange.Address
SolverSolve userFinish:=True
SolverFinish KeepFinal:=1

Set cellChange = cellChange.Offset(1, 0)
Set cellGoal = cellGoal.Offset(1, 0)

Next i
MsgBox "done"
End Sub