VBA Loop using solver

[ec41tp]

Hi All,

I am currently trying to automate a spreadsheet which uses solver to determine the value of a cell. As with the code below I use input boxes to determine the value of the 'Set Target Cells', of the 'Cells to be changed' and of the 'Contraints'.

I already know what columns which will be selected before hand, and I have 150 rows which I want to run the optimizing function on separately.

TargetVal will always be in column B. ChangeVal will always be in M:V and DesiredVal will always be C:K.

Given I have 150 rows I want to run the solver function in all of them using a loop.

Can anyone please help/advise?


Thanks in advance!!!



Dim TargetVal As Range, ChangeVal As Range, DesiredVal As Range

Cells.Select

With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With

With Application

Set TargetVal = .InputBox(Title:="Select a range in a single row", _
prompt:="Select your range which contains the ""Set Cell"" range", Default:=Range("C11:E11").Address, Type:=8)

TargetVal.Font.ColorIndex = 4


Set ChangeVal = .InputBox(Title:="Select a range in a single row", _
prompt:="Select the range of cells that will be changed", Default:=Range("G8:G10").Address, Type:=8)

ChangeVal.Font.ColorIndex = 10

Set DesiredVal = .InputBox(Title:="Select a range in a single row", _
prompt:="Select the range which will constrain the optimizer", Default:=Range("C12:E12").Address, Type:=8)


DesiredVal.Font.ColorIndex = 14
End With

Application.ScreenUpdating = False
'Initiate Solver function
SolverReset

SolverOptions precision:=0.0000001

SolverOk SetCell:=TargetVal.Cells, MaxMinVal:=3, ValueOf:="0""", ByChange:=ChangeVal.Cells

SolverAdd CellRef:=DesiredVal.Cells, Relation:=2, FormulaText:="0"

SolverOk SetCell:=TargetVal.Cells, MaxMinVal:=3, ValueOf:="0", ByChange:=ChangeVal.Cells

SolverSolve True

Application.ScreenUpdating = True

End Sub