The need for speed: faster VBA 3

[GregLocock]

Any tips for speeding up a loop?

Here is my first attempt at a replacement for the solver. It works down the list of arguments in column h, setting them to a random position between the limits in columns i and j. After each new value is set it checks to see whether the target value is better than bestttarget, if it is then it stops. The Solver can't make much impression on this problem since there are many local optima.

All well and good. Unfortunately it takes about 1 second per iteration, and I suspect this problem will need hundreds of thousands of iterations.

The do loop is in there to stop things getting too dull, it is not strictly necessary.

Sub optimiser()
'
' optimiser Macro
' by Greg Locock
'

Dim hrows As Integer, s As String, maxinput As Single, current As Single
Dim mininput As Single, besttarget As Single, target As Single, NoChange As Integer
Range("H42&quot.Select
besttarget = ActiveCell.Value
NoChange = 0
Do
For hrows = 31 To 40
s = Format((hrows), "0&quot
Range("$h$" & s).Select
current = ActiveCell.Value
Range("$i$" & s).Select
maxinput = ActiveCell.Value
Range("$j$" & s).Select
mininput = ActiveCell.Value
Range("$h$" & s).Select
ActiveCell.Value = ((maxinput - mininput) * Rnd + mininput)
Range("H42&quot.Select
target = ActiveCell.Value
If (target > besttarget) Then
besttarget = target
NoChange = 0
Stop
Else
Range("$h$" & s).Select
ActiveCell.Value = current
NoChange = NoChange + 1
End If
Next hrows
NoChange = NoChange + 1
Loop Until NoChange > 32000

End Sub

it would also be nice if it stored the best values somewhere before stopping. How do I increment columns in the same way as s and hrow works? I know its easy, but asking is easier!



Cheers

Greg Locock

 

[GregLocock]

By the way I've just noticed this is an old version that reverts to the previous value if target doesn't improve. The later version of this sub does not do this, it explores the full parameter space, randomly.

Also, it does need to check the limits for each value each time, since the limits are interdependent.



Cheers

Greg Locock

 

[joerd]

I have rewritten your code a bit. Using Cells(i,j), you can avoid the string manipulations (i = row index, j=column index, where A = column 1, B=column 2 etc., so column H = column 8).
Also, in VBA it is not necessary to Select the cell first and then use ActiveCell.Value to update it. I know that when you record a macro, Excel generates that type of code, but I usually rewrite the code right away.
I also added a little for...next loop to store the values of the best estimate in column L (column 12). Modify as you please. The first besttarget is also taken from L42, i.e. the last besttarget of the previous run.

I am not at all convinced that your random search will give the global optimum in any finite amount of time, but with a bit of luck you can use it to feed the solver with a good initial estimate.

Sub optimiser()
'
' optimiser Macro
' by Greg Locock
' modified by Joerd

Dim hrows As Integer, i As Integer, NoChange As Integer
Dim maxinput As Single, current As Single, mininput As Single
Dim besttarget As Single, target As Single   

besttarget = Range("L42").Value
NoChange = 0
Randomize
Do
    For hrows = 31 To 40
        current = Cells(hrows, 8).Value     'cell $H$hrow
        maxinput = Cells(hrows, 9).Value    'cell $I$hrow
        mininput = Cells(hrows, 10).Value   'cell $J$hrow
        Cells(hrows, 8).Value = ((maxinput-mininput)*Rnd + mininput)
        target = Range("H42").Value
        If (target > besttarget) Then
            besttarget = target
            NoChange = 0
            'update the cells in column L that store the best solution
            For i = 31 To 40    
                Cells(i, 12).Value = Cells(i, 8).Value
            Next i
            Range("L42").Value = target
            'Stop
           Else
            NoChange = NoChange + 1
        End If
    Next hrows
    NoChange = NoChange + 1
Loop Until NoChange > 32000

End Sub

Cheers,

Joerd

 

[ivanlocke]

This may work for you or be a great pain, but you might think about doing everything in vba and just using the spreadsheet as your data entry. Your function would pull everything into variables and arrays and then in the middle of your iterations would be the actual calculating code. I have found this to be much faster, but it can require much more programing.

 

[pmover]

Greg,

try implementing:

application.screenupdating=false

after the dim statements and include

application.screenupdating=true

as the last line in code before ending subroutine.

this code deactivates updating the screen after each line of code execution.
-pmover

 

[GregLocock]

ivan - yes, that is a possibility. On the other hand if I wanted to write programs I'd use a real environment, not mess about in a tacked on afterthought like VBA!

I must admit, this is a lesson I keep (not) learning, time spent on hugely complex spreadsheets is of relatively little value when I eventually decide to write the program up properly.

joerd - After about 20000 attempts the result was about 15% better than my best attempt by hand, compared with a theoretical optimum that is probably not achievable. The obvious technique to use is some sort of genetic search, but unfortunately I can't get GAsolver to run on my computer, so I may end up writing my own. Thanks for the rewrite that is much tidier.

pmover - great tip





Cheers

Greg Locock

 

[melone]

Greg, is this algorithm some sort of binary search?

 

[GregLocock]

No it is literally a scattergun approach, firing random, legal, input variables into a simulation and measuring the result. A binary approach would not work because there are many local optima.

Having left the latest version running all night, starting from a random set of parameters, it got to within 3% of my best result to date. I know that optimisation using the limits for each variable seen in the best results so far is very rapid, so I am not really worried by the fact that it has yet to reach my best result.

I have taken my own advice and am now knee deep in code, solving it with a genetic approach. This is surprisingly easy, in principle, just rather tedious to code.


Cheers

Greg Locock

 

[GregLocock]

I've just downloaded a simple but/and usable genetic solver called genetik201.zip (google for it).

Seems to be working, it is very easy to understand.



Cheers

Greg Locock

 

[MortenA]

With regards to screenupdate - then it automatically returns to true when the sub is finished.



Best Regards

Morten

 

[MikeRL]

If you are seriously into using monte calo type simulations for this type of thing consider @Risk which is a Monte Carlo add in for Excel. I have used it for other types of simulation but it can be used for the type of problem you describe.