Macro with Solver loop

Hi -

I recorded my step for Solver as a Macro (code below) and am trying to have the macro replicate the steps for all cells in column AJ (there will be 60K+ cells in the workbook). I have no real VBA skills to speak and I need help please! Thanks!

Sub Macro1()
'
' Macro1 Macro
'

'
SolverOk SetCell:="$AJ$2", MaxMinVal:=2, ValueOf:=5, ByChange:="$AJ$2", Engine _
:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:="$AJ$2", MaxMinVal:=2, ValueOf:=5, ByChange:="$AJ$2", Engine _
:=1, EngineDesc:="GRG Nonlinear"
SolverSolve
End Sub

For reference, these are my Solver specs:
Capture.PNG

Perhaps a macro like this then?

Option Explicit

Sub SolvLoop()
Dim i As Long

For i = 2 To Range("AJ" & Rows.Count).End(xlUp).Row

SolverReset

SolverOk SetCell:="$AJ$" & i, MaxMinVal:=2, ValueOf:=5, ByChange:="$AJ$" & i, Engine:=1
SolverAdd CellRef:="$AJ$" & i, Relation:=1, FormulaText:="$AE$" & i
SolverAdd CellRef:="$AJ$" & i, Relation:=3, FormulaText:="0"
SolverAdd CellRef:="$AP$" & i, Relation:=3, FormulaText:="5"
SolverSolve Userfinish:=True

Next

End Sub

As you have constraints in your solver setup but not in the recorded macro I'm a bit unsure if they should be included or not. In this macro these constraints are included.

In the future don't forget to wrap you code when posting.

Alf

Hi Alf - I copied the macro code into the VBA editor and ran the macro but nothing in the data changed. It's like it didn't run.

Strange. Could you click on solver and see if setup is changed i.e

target cell should be $AJ$xxx where xxx is the last row number with data in the AJ column. All the other parameters should be change accordingly

"AJxxx < = "AExxx" and so forth. This should indicate that the solver loop is working.

As for the data change could you upload a small sample file say a 100 rows so that I could do some testing.

Alf

Hi Alf - Even with 25 rows the file is too large. Can we take this thread offline over email so that I can send you the file?

Gotcha, yeah it might help if i explain what I'm trying to achieve. I'll lay it out by what cells are what.

AE2: current price (this is a number value cell)
AI2: profit per unit at current price (this is a number value cell)
AJ2: promotional price (this is a formula cell)
AK2: promotional profit per unit (=AI2-(AE2-AJ2) (formula cell)
AP2: absolute value of promotion price/promotional profit per unit (=abs(AJ2/AK2)) (formula cell)

I'm trying to find what the minimum AJ2 would be that would give me an AP2 that is greater than 5 (5 at a minimum). AJ2 has to be greater than 0 (since it's a selling price) and has to be less than AE2 since it's a promotional price.

@mrshorty - makes sense. I've edited the Changing cell to AK2 which gives me back the same answer in AJ2 so I think that will work. I've edited the macro Alf wrote but it still is not running. I click run and nothing happens.

to clarify for AJ2 = there is no formula in the cell currently. this is what I'm trying to solve for.

So I'm not necessarily trying to find the value that gives me AP2=5. I'd like to the find the minimum value of AJ2 that gets me as close as possible to AP2=5, therefore AP2 >= 5 in the constraints in Solver. AI2 is technically a function of AE2 but these are both specific data points that I have and are not formulas or variables that will change. AI2 will adjust at the same rate that AE2 does (i.e. if AE2 increased by 5, AI2 increases by 5). I don't believe it can be done in the manner you're saying because no there will not be just one possible value as I'm trying to find the minimum value and as AI2 and AK2 could be negative values.

I've ran solver manually on the first 20 cells and it is giving me the answer I need. I just need to be able to create a loop to do this calculation on every cell.

So I tried running Alf's code again and somehow it ended up working this time and has been working every time since! Thanks so much anyway!

One other question. What edit would you make to get the macro to only run on visible cells?

As I assume with visible cells that you got hidden rows you could try this modification on the original code:

For i = 2 To Range("AJ" & Rows.Count).End(xlUp).Row

If Rows(i).Hidden = True Then

Else

SolverReset

SolverOk SetCell:="$AJ$" & i, MaxMinVal:=2, ValueOf:=5, ByChange:="$AJ$" & i, Engine:=1
SolverAdd CellRef:="$AJ$" & i, Relation:=1, FormulaText:="$AE$" & i
SolverAdd CellRef:="$AJ$" & i, Relation:=3, FormulaText:="0"
SolverAdd CellRef:="$AP$" & i, Relation:=3, FormulaText:="5"
SolverSolve Userfinish:=True

End If

Next

Alf

I have tried Alf's code for similar issue and I think it partially works but as I am new to VBA I might have messed up something. I have 16 columns (from D to T) that have same formulas and different input values. I want to run the solver for each column individually. Solver goal is row 56 and I want it to result to 0 by changing values in rows 41:44. The solver runs through all of the columns but the solver goals do not result very close to 0. If I run solver individually for each column I get very close to 0. I also have 2 conditions: 48:51=0 and 41:44>=0.

Help would be much appreciated.

This is what I have been using but something is clearly wrong:

Option Explicit

Sub SolvLoop()

Dim i As Long

For i = 56 To Range("D" & Rows.Count).End(xlUp).Row

SolverReset
    SolverOk SetCell:="D" & i, MaxMinVal:=3, ValueOf:=0, ByChange:="$D$41:$D$44", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$D41:D44$", Relation:=3, FormulaText:="0"
    SolverAdd CellRef:="$D48:D51$", Relation:=2, FormulaText:="0"
    SolverSolve Userfinish:=True
    Next
End Sub

Hi Alf and thank you for your reply. Yes, D41:D44 and D48:D51 changes to E41:E44 and E48:E51 respectively. All columns are basically identical with formulas and are independent to each other. Only the input values are different.

This VBA is still quite confusing to me and I need to ask you one thing before I try your code:
I have determined "i" as "Dim i as long". But how should I determine the j now?

Unfortunately I cannot upload the file as this is for work.

Cheers
Ben

Ok so this is the code I am using now:

Option Explicit
Sub Makro2()

    Dim i As Long
    Dim j As Long

    For j = 4 To 20
   
    For i = 56 To Range("D" & Rows.Count).End(xlUp).Row

    SolverReset
    SolverOk SetCell:=Cells(i, j).Address, MaxMinVal:=3, ByChange:=Range(Cells(41, i), Cells(44, i)), Engine:=1
    SolverAdd CellRef:=Range(Cells(41, i), Cells(44, i)), Relation:=3, FormulaText:="0"
    SolverAdd CellRef:=Range(Cells(48, i), Cells(51, i)), Relation:=2, FormulaText:="0"
    SolverSolve Userfinish:=True
    Next
    Next
End Sub

There is definitely something happening BUT after I run the solver the values that needs to change in cells 41:44 on column range D:E do not change at all. As a result of this the values that I want to become zero in cells D56:E56 are anything but zero.

Ok I tried to make the modifications that you suggest but for some reason the cells 41:44 on column range D:E do not change at all. As a result of this the values that I want to become zero in cells D56:E56 are anything but zero.

Here is the current code:

Option Explicit
Sub Makro2()

    Dim i As Long
    Dim j As Integer

    For j = 4 To 20
    For i = 56 To Range("D" & Rows.Count).End(xlUp).Row

    SolverReset
    SolverOk SetCell:=Cells(i, j).Address, MaxMinVal:=3, ByChange:=Range(Cells(41, j), Cells(44, j)).Address, Engine:=1
    SolverAdd CellRef:=Range(Cells(41, j), Cells(44, j)).Address, Relation:=3, FormulaText:="0"
    SolverAdd CellRef:=Range(Cells(48, j), Cells(51, j)).Address, Relation:=2, FormulaText:="0"
    SolverSolve Userfinish:=True
    Next
    Next
End Sub

What do you wish to change? The target cell starts in column D and goes down from row 56 to ??. Having done this loop j changes to 5 i.e column E and changes row from 56 to ??.

The "ByChange" stays constant i.e. row number is constant 41 and 44 only column changes from D to E after the row loop i has gone through all values.

The same goes for the constraint, constant row number and after all i values have been tested column changes from D to E.

Since you can't upload the file try to explain what you hope to achieve after each change in i and after a change in j.

Alf

Hi, so I made a mistake in my previous post: I meant to say D:S instead of D:E.
I have modified the sheet in order to be able to post it here. Please see link below. Each column includes same formulas, only input values vary. Each column calculates values that are dependent on the input value and the column values can be plotted into a curve. In row 56 is solver goal which is to be 0. Rows 41:44 need to be solved. And Rows 48:51 =0. Rows 41:44>=0. The VBA code does not solve the values for some reason, maybe I have understood something wrong, but when I use solver individually for each column I can manage to get them solved correctly. Solving them individually takes along time however.

Link: https://www.dropbox.com/s/2pw8k8xmyt73214/SB.xlsm?dl=0

The first thing I noticed was that calculation was set to "manual" and solver was not to happy about it so I set it to "automatic". I then wrote a short macro for the range D to S:

Option Explicit

Sub SolvLoop()
Dim i As Integer

For i = 4 To 19

SolverReset

SolverOk SetCell:=Cells(56, i).Address, MaxMinVal:=3, ValueOf:=0, ByChange:=Range(Cells(41, i), Cells(44, i)).Address, Engine:=1
SolverAdd CellRef:=Range(Cells(41, i), Cells(44, i)).Address, Relation:=3, FormulaText:="0"
SolverAdd CellRef:=Range(Cells(48, i), Cells(51, i)).Address, Relation:=2, FormulaText:="0"
SolverSolve Userfinish:=True

Next

End Sub

It loops through columns D to S and tries its best to find proper solutions but it does not succeed that well. Uploading two images, the first is a snippet from you uploaded file and the second one is how the result looks after running the macro.

solver_org.jpg

Solver_macr.jpg

Alf

Thank you very much Alf, I will add some solver options to the code and see if that would help to reach better results. But otherwise the code seems to work well.

Ben

Hi Alf,

For some reason I don't get any #num! errors and the solver runs very nicely now. Sometimes it is not able to find values for one or max two columns in 41-44 rows that result in zero in row 56. Then I just manually insert a good estimate to the cells in 41-44 that the solver did not solve properly and run the solver again. This helps 9 times out of 10. And if not I just manually insert another estimate and solve it again. I guess the solver is very sensitive to the initial values that are in 41-44 and based on those it either finds a solution or not. I have heard that for the solver there is possible to write a piece of code that gives some initial estimated values in order to result in better outcome, but I think it will be very large task and if the estimations are wrong then what happens.

Ben

solver is very sensitive to the initial values that are in 41-44 and based on those it either finds a solution or not.

Yes that's true especially is function is oscillating a bit. But it seems to me that you managed to overcome that problem.

Of course it's possible to let the macro check the target values in range D56:S56 and it one or more is not zero do a rerun on that particular column and set a new starting value perhaps using an input box. But to guesstimate starting value???

As far as I can see you consider this a minor problem i.e. not worth the effort so let's keep it that way.

Alf