Iterate values through calculation using VBA and record results

[Nick_London]

Hello,

I have a calculation set up that populates a value based on various combinations of input variables. However there are hundreds of potential interations so I would like to use VBA to loop through values (or another method) and record the results.

In the attached sheet, I am calculating values in Column K by adjusting the inputs in J8:J12 based on a vlookup of corresponding table values of what's in J8:J12.

However I also have the following constraints:

1) The total of the inputs (J8:J12) must equal 10,000,000.
2) Column M defines additional constraints in terms of the maximum value each input can take on, e.g J11 (var 4) cannot be higher than 1,000,000.

I would like to loop through every combination of say increments of 500,000 and record the value in cell K14.

As an example, I have created the sheet "results" to show the output based on two alternative input combinations.

The end game here is to find the combination of inputs that maximise the sum of outputs in K14. I'm thinking, if I record the results from all of the combinations then I could filter the results sheet to find the combination that generates the max.

Note, I have tried to find the combination that maximises K14 using Excel's Solver but it is giving incorrect results even after it says that it found a solution. After reading about this on the internet, it seems sume functions such as vlookup do not work with solver hence I trying to search for a workaround.

Hope someone can help me with VBA element.

Thanks,

Nick

[SamT]

I've thought and thought, and have no ideas. This might give you or someone some ideas




Formula As Text






Input
Incrementer
Output

OutPut is VlookUp from Table AA:FF
See formulas


For 1 to 1000
=I5*10000
#N/A



For 1 to 800
=I6*10000
#N/A



For 1 to 600
=I7*10000
#N/A





For 1 tp 100
=I8*10000
#N/A





for 1 to 1000
=I9*10000
#N/A





Column Must total = 1000

Solve for Maximum Total

















48E+12 Possibilities





















Input
Incrementer
Output





For 1 to 100
100,000
#N/A





For 1 to 80
100,000
#N/A





For 1 to 60
100,000
#N/A





For 1 tp 10
100,000
#N/A





for 1 to 100
100,000
#N/A





Column Must total 100

Solve for Maximum Total

















480 million possiblities





















Input
Incrementer
Output





For 1 to 10
1,000,000
#N/A





For 1 to 8
1,000,000
#N/A





For 1 to 6
1,000,000
#N/A





For 1 tp 10
100,000
#N/A





for 1 to 10
1,000,000
#N/A





Column Must total ?


Solve for Maximum Total

















480,000 possiblities

[D_Marcel]

Probably I'm crazy... but even with increments of 500,000 (five hundred), we would have quintillions of combinations, because:


Var1 10.000.000
Var2 8.000.000
Var3 6.000.000
Var4 1.000.000
Var5 10.000.000


Dividing these max values by 500, you'll have to each variable the follow possibilities, considering several attempts of 500 to each one:


Var1 20.000
Var2 16.000
Var3 12.000
Var4 2.000
Var5 20.000


So:


Var1 * Var2 * Var3 * Var4 * Var5
20.000 * 16.000 * 12.000 * 2.000 * 20.000 = 153.600.000.000.000.000.000
Considering that the following versions of Excel 2007 has 1.048.576 rows, you have to consider a bigger interval to test.
Decreasing the incrementer to 400.000 (four hundred thousand), you'll have 468.750 combinations.


SamT, don't mind if this looks like a "rewrite" of your analysis.


Nick, I even start to develop something but it would take some hours. Some suggestions:


> Using a For To Step, set the interval according to Max Input of the variables, and the jumper. You'll have five intervals with the same jumper;
> While you incrementing the value of the first variable, you keep the others unchanged;
> Try to build another loop inside this one (this is not recommended from the point of view of performance but I can't think in another thing) to get all the current values of Input and Output;
> Insert these current values into an array, insert also the current sum.
> Unload the array with the values;
> Next Loop;


Do this to each variable.


Good luck.


Douglas

[Nick_London]

Thanks Sam and Douglas - I will need to try to understand and digest what you guys are suggesting and then see if I can write elements of the code myself. On a related issue, I read on the internet that Excel 2010 Solver as an option for selecting an evolutionary search/genetic algorithm for optimisation which is supposedly able to work with the vlookup function? If someone has access to later versions of Excel (2010 onwards), would they be able to test my data using Solver against it to see if it works?

Oh and I didn't realise the constraints would increase the number of permutations, I thought they would reduce them!


Thanks,

Nick

[SamT]

@ nick, you mean be setting the step values to 500,000 or something? oh yeah that really reduce the iterations.

@D_Marcel, go for it.

@all,

For your consideration

Option Explicit

Sub Test()
'Rearranged the Vars From OP's original attachment in descending value

Dim Var1, Var2, Var3, Var4, Var5
Dim Inc1, Inc2, Inc3, Inc4, Inc5 'Incrementers
Dim StoV1, StoV2, StoV3, StoV4, StoV5 'Var Stores
Dim StoI1, StoI2, StoI3, StoI4, StoI5 'Incrementer Stores
Dim Result As Double
Dim Temp As Double
Dim i As Long
'VlookUp1, 2, 3, 4, and 5 represents the formulas, cuz i am lazy right now

Const MastLimit As Long = 10000000
Const Limit1 As Long = 10000000
Const Limit2 As Long = 10000000
Const Limit3 As Long = 8000000
Const Limit4 As Long = 6000000
Const limit5 As Long = 1000000

Const IterateLimit As Long = 1000000

Inc1 = Limit1 / 10
Inc2 = Limit2 / 10
Inc3 = Limit3 / 10
Inc4 = Limit4 / 10
Inc5 = limit5 / 10

For Var1 = 0 To Limit1 Step Inc1
If Var1 + Var2 + Var3 + Var4 + Var5 > MastLimit Then Var1 = Var1 - Inc1
For Var2 = 0 To Limit2 Step Inc2
If Var1 + 0 + Var3 + Var4 + Var5 > MastLimit Then Var2 = Var2 - Inc2
For Var3 = 0 To Limit3 Step Inc3
If Var1 + Var2 + Var3 + Var4 + Var5 > MastLimit Then Var3 = Var3 - Inc3
For Var4 = 0 To Limit4 Step Inc4
If Var1 + Var2 + Var3 + Var4 + Var5 > MastLimit Then Var4 = Var4 - Inc4
For Var5 = Inc5 To limit5 Step Inc5
If Var1 + Var2 + Var3 + Var4 + Var5 > MastLimit Then Next Var1

i = i + 1
If i >= IterateLimit Then GoTo Done
If Var1 + Var2 + Var3 + Var4 + Var5 > MastLimit Then Var5 = Var5 - Inc5
'Temp = VLookUp1 _
+ VlookUp2 _
+ VlookUp3 _
+ VlookUp4 _
+ VlookUp5

If Temp > Result Then
Result = Temp
StoV1 = Var1
StoV2 = Var2
StoV3 = Var3
StoV4 = Var4
StoV5 = Var5
End If
Next
Next
Next
Next
Next

Done:
MsgBox Result

End Sub

[Paul_Hossler]

I think I understand what you're wanting to do




Option Explicit
Option Base 1


Const iRequiredTotal As Long = 10000000
Const iIncrement As Long = 500000
Const iNumberVariables As Long = 5


Dim A() As Double
Dim vMax As Variant
Dim rData As Range

Sub Incrementer()
Dim iCounter As Long, i As Long, iMaxLookupElement As Long, iTotal As Long
Dim dMaxLookupTotal As Double
Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long
Dim sMessage As String


ReDim A(1 To (iRequiredTotal / iIncrement) ^ iNumberVariables, 1 To iNumberVariables + 2)
vMax = Array(10000000, 8000000, 6000000, 1000000, 10000000)

iCounter = 0

'load A array with possible variables
For i1 = 0 To iRequiredTotal - 1 Step iIncrement
For i2 = 0 To iRequiredTotal - 1 Step iIncrement
For i3 = 0 To iRequiredTotal - 1 Step iIncrement
For i4 = 0 To iRequiredTotal - 1 Step iIncrement
For i5 = 0 To iRequiredTotal - 1 Step iIncrement
iCounter = iCounter + 1
A(iCounter, 1) = i1
A(iCounter, 2) = i2
A(iCounter, 3) = i3
A(iCounter, 4) = i4
A(iCounter, 5) = i5
Next i5
Next i4
Next i3
Next i2
Next i1

'mark if a variable > max
For iCounter = LBound(A, 1) To UBound(A, 1)
For i = LBound(vMax) To UBound(vMax)
If A(iCounter, i) > vMax(i) Then A(iCounter, iNumberVariables + 1) = -1
Next I
Next iCounter

'mark if a total <> maxrequired
For iCounter = LBound(A, 1) To UBound(A, 1)
If A(iCounter, iNumberVariables + 1) <> -1 Then
iTotal = 0

For i = 1 To iNumberVariables
iTotal = iTotal + A(iCounter, i)
Next I

If iTotal <> iRequiredTotal Then A(iCounter, iNumberVariables + 1) = -1

End If
Next iCounter

Set rData = Worksheets("data").Cells(1, 1).CurrentRegion

'lookup variable in data
With Application.WorksheetFunction
For iCounter = LBound(A, 1) To UBound(A, 1)
If A(iCounter, iNumberVariables + 1) <> -1 Then
A(iCounter, iNumberVariables + 2) = 0
For i = 1 To iNumberVariables
A(iCounter, iNumberVariables + 2) = A(iCounter, iNumberVariables + 2) + _
.VLookup(A(iCounter, i), rData, i + 1, False)
Next I
End If
Next iCounter
End With
'look for max
For iCounter = LBound(A, 1) To UBound(A, 1)
If A(iCounter, iNumberVariables + 1) <> -1 Then
If A(iCounter, iNumberVariables + 2) > dMaxLookupTotal Then
dMaxLookupTotal = A(iCounter, iNumberVariables + 2)
iMaxLookupElement = iCounter
End If
End If
Next iCounter
sMessage = "Max total = " & Format(dMaxLookupTotal, "#,##0.000") & vbCrLf
sMessage = sMessage & "Max total element = " & Format(iMaxLookupElement, "#,##0") & vbCrLf
For i = 1 To iNumberVariables
sMessage = sMessage & "Var # " & Format(i, "0") & " = " & Format(A(iMaxLookupElement, i), "#,##0.000") & vbCrLf
Next I

MsgBox sMessage

Stop
End Sub




More brute force than I'd like

Paul

[SamT]

More brute force than I'd like

I know, but I can't see any way except brute force. But then, I'm just a big ape with no fine-esses.

[D_Marcel]

You really are competitive guys. I would spend a lot of time and certainly the code would be bigger.

To who's not advanced in VBA, like me course, there's a lot to learn in these two codes.

Thank you guys.

[Nick_London]

Many Thanks Sam and Paul.

I would like to echo Douglas's comments, there is indeed a lot to learn in the codes you have kindly provided. But I'm afraid my lack of VBA at this level means I'm falling at the first hurdle. I have tried to quickly test out the codes and getting errors.

Paul Code: I am getting an overflow error generated by the following line:
ReDim A(1 To (iRequiredTotal / iIncrement) ^ iNumberVariables, 1 To iNumberVariables + 2)

And in Sam's code a compile "next without for" error at the following line:

If Var1 + Var2 + Var3 + Var4 + Var5 > MastLimit Then Next Var1

---------------------------------------------------------------------------------
Am I right to assume we do not need to change the current setup in my spreadsheet in any way for these to work? Sam in your code I could not see any references to the worksheet. And I could not understand the following comment: "'VlookUp1, 2, 3, 4, and 5 represents the formulas"

Applogies if I am asking some very basic questions!

Thanks,

Nick

[Paul_Hossler]

Well, I'm running 32 bit Excel 2010 in Win7 64 bit but that should not make any different (AFAIK)

Here's a screen shot of my results

and in the next post I'll post the xls

Paul

[Paul_Hossler]

and the xls

[SamT]

Nick,

My bad. That is not code, just an algorithm. IOW, an outline of possible code.


"'VlookUp1, 2, 3, 4, and 5 represents the formulas"That is where the coded formulas are supposed to go in the algorithm.

[SamT]

Paul took the algorithm and ran with it.

1st: 'load A array with possible variables"
he put all the variables into an array(Var1-5, Inc1-5, and Limit1- 5, which would be hundreds of time faster than the basic algorithm)

2nd: "'mark if a variable > vmax"
He ran thru the array to insure that no Var was larger than it's own maximum allowed.

3rd: "'mark if a total <> maxrequired"
He made sure that all Vars in the array totaled 10,000,000

4th: "lookup variable in data"
He ran the array against the VLookUp formulas and put the results into the array, replacing the Vars.

Finally: "look for max"
He found the largest result in the array.

Beautiful work Paul.

[SamT]

The only things in Paul's code that I personally would make are style changes that make it easier for you to modify for different values of your Vars and incrementations


Const iRequiredTotal As Long = 10000000 'Required sum of Vars
Const iIncrement As Long = 500000 'Incrementation value

Const iNumberVariables As Long = 5 'Count of MaxVar variables
Const MaxVar1 As Long = 10000000
Const MaxVar2 As Long = 8000000
Const MaxVar3 As Long = 6000000
Const MaxVar4 As Long = 1000000
Const MaxVar5 As Long = 10000000

Const LkUpSht As String = "Data" 'Name of sheet with LookUp Table
Const LkUpRng As String = ""A2:F1202" 'full address of LookUp Table on LkUpSht


Sub Incrementer()
Dim A() As Double 'Moved from above
Dim vMax As Variant 'Moved from above
Dim rData As Range 'Lookup table range (Moved from above)
'
'Other variables declared here
'

Redim A(1 To (iRequiredTotal / iIncrement) ^ iNumberVariables, 1 To iNumberVariables + 2)
vMax = Array(MaxVar1, MaxVar2, MaxVar3, MaxVar4, MaxVar5) 'Changed
'
' more code here
'
Set rData = Worksheets(LkUpSht).Range(LkUpRng) 'Changed. (Located just above the 4th step mention in previous post.)
'
' Remaining code here
'

End Sub

[Paul_Hossler]

@SamT --

(blushing)

If I were polishing it up for production, I'd revise it to pull in the 5 (currently) max values, the desired total (10,000,000 now), etc. from WS ranges and output the results to other WS ranges

It'd be a little more complicated, but much more flexible (look nicer too)

Paul

[Nick_London]

Thanks Paul (and Sam for high level code explanantion). I can confirm this runs perfectly, even in a Excel 2003. I'm very impressed - if you guys lived locally in London I'd buy both of you a drink or two!

Anyway, I'm gonna play around with it for a bit and and see if I can integrate Sam's suggestions in terms of layout and flexibility. I did try changing the increment to different levels but this did not work, don't know if this an expected limitation of the code or because of an error. The only other element that I thinking about in terms of flexibility is whether it would be straight foward to add minimum spend for the variables as well as the existing max spend limitations.

Nick

[SamT]

I suspect that incrementation/n = Runtime * 5* 10n so you might take that into consideration when testing