Loop With Solver VBA

Question

Hi I have the following code which runs a single optimisation through solver which I would like to run in a loop. the single run code is:

    Sub Macro4
SolverReset
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
    SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:="$D$41"
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverSolve UserFinish:=True
    SolverFinish KeepFinal:=1


    Range("D37").Select
    Selection.Copy
    Range("E41").Select
    ActiveSheet.Paste
    Range("D36").Select

Application.CutCopyMode = False
Selection.Copy
Range("F41").Select
ActiveSheet.Paste
Range("D36").Select


Range("D7:R7").Select
Application.CutCopyMode = False


   Selection.Copy
    Range("I41").Select
    ActiveSheet.Paste
End Sub

The solver optimises to a value in $D$41 (amongst other constraints)and then pastes the solutions by copying a couple of individual cells and an array and then pasting them alongside the original target cell (i.e. into row 41.) This works well. However I am trying to get it to run for a column of target cells by getting it to optimise to each cell in the column in turn, by using a loop (or better alternative), before pasting the solutions alongside it as it does for the single run code. For example I am trying to merge it with the following code

    Sub Complete()
'
'
'
Dim Count As Double
Dim Count2 As Integer
Dim increment As Double
increment = Range("C43").Value
strt = Range("C41").Value
fnsh = Range("C42").Value

    For Count = strt To fnsh Step increment
        Count2 = Count / increment
        Range("D41").Offset(Count2, 0) = Count
    Next Count
End Sub

which generates the column of target values (from strt to fnsh using increment) for Solver to take and use instead of (I think!!!) the part that says FormulaText:="$D$41". However I run into various errors and complaints (method 'Range' of Object'_Global'failed- which highlights the line "Range(E41+Count").Select. The complete code I have is:

`Sub Macro5()
   Dim Count As Double
Dim Count2 As Integer
Dim increment As Double
increment = Range("C43").Value
strt = Range("C41").Value
fnsh = Range("C42").Value

For Count = strt To fnsh Step increment
        Count2 = Count / increment
        Range("D41").Offset(Count2, 0) = Count

    SolverReset
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
    SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:="$D$41:$D$41+Count"
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverSolve UserFinish:=True
    SolverFinish KeepFinal:=1


    Range("D37").Select
    Selection.Copy
    Range("E41+Count").Select
    ActiveSheet.Paste
    Range("D36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F41+Count").Select
    ActiveSheet.Paste

    Range("D7:R7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("I41+Count").Select
    ActiveSheet.Paste

Next Count 
End Sub`

I just need it to update which cell it is optimising to (and putting it in the constraint of solver), then updating which cells to copy and where to paste them. Any help would be greatly appreciated.

What does your script look like with the loop around it? What are the exact errors you encounter and in what lines? Have you looked up the errors and tried to remedy them? Have you tried to just change the "$D$41" into something else with code, and what did that look like? — K_B
I got errors such as "Compile error: Expected End of Statement". But the complete code now only says method 'range' of object'_global' failed And highlights the RangeXXX.Select code which I assume has something with the way I am tryiung to get it to paste into the right cells. I have updated the question with new code. — Mary
You should run the code in debug mode so you can see which line it falls over and what variables have other than expected values. Do this by selecting the line Sub xxx of the first sub you start and then press F9, now it will have a colored background and a bullet in front of it. When you now trigger the start of the code it will stop there. With F8 you can step through the code line by line. With mouse hover-over you can inspect the values of all variables. Also it is advisable to activate the local watch window to see all local variables and objects. — K_B

Dick Kusleika Dick Kusleika · Accepted Answer · 2013-03-19T15:04:31

Range("E41+Count").Select

This is improper syntax. The following is preferred:

Range("E41").Offset(Count,0).Select

or you could use

Range("E" & 41 + Count).Select

In general, avoid using Range without the sheet name in front of it. Also, only Select when you need to, and that's almost never. Here's an example that doesn't use any Select methods.

Sub Complete()

    Dim lStrt As Long, lFnsh As Long
    Dim lCount As Long, lCount2 As Long
    Dim lIncrement As Long

    For lCount = lStrt To lFnsh Step lIncrement
        lCount2 = lCount / lIncrement

        Sheet1.Range("D41").Offset(lCount2, 0).Value = lCount

        SolverReset
        SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
        SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
        SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
        SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
        SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:=Sheet1.Range("D41").Offset(lCount2, 0).Address
        SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
        SolverSolve UserFinish:=True
        SolverFinish KeepFinal:=1

        Sheet1.Range("E41").Offset(lCount2, 0).Value = Sheet1.Range("D37").Value
        Sheet1.Range("F41").Offset(lCount2, 0).Value = Sheet1.Range("D36").Value
        Sheet1.Range("D7:R7").Copy Sheet1.Range("I41").Offset(lCount2, 0)

    Next lCount

End Sub

Loop With Solver VBA

2 Answers