The need for speed: faster VBA
The need for speed: faster VBA
(OP)
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").Select
besttarget = ActiveCell.Value
NoChange = 0
Do
For hrows = 31 To 40
s = Format((hrows), "0")
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").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!
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").Select
besttarget = ActiveCell.Value
NoChange = 0
Do
For hrows = 31 To 40
s = Format((hrows), "0")
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").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
RE: The need for speed: faster VBA
Also, it does need to check the limits for each value each time, since the limits are interdependent.
Cheers
Greg Locock
RE: The need for speed: faster VBA
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
RE: The need for speed: faster VBA
RE: The need for speed: faster VBA
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
RE: The need for speed: faster 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
RE: The need for speed: faster VBA
RE: The need for speed: faster VBA
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
RE: The need for speed: faster VBA
Seems to be working, it is very easy to understand.
Cheers
Greg Locock
RE: The need for speed: faster VBA
Best Regards
Morten
RE: The need for speed: faster VBA