×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Are you an
Engineering professional?
Join Eng-Tips Forums!
• Talk With Other Members
• Be Notified Of Responses
• Keyword Search
Favorite Forums
• Automated Signatures
• Best Of All, It's Free!

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

#### Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

# The need for speed: faster VBA3

## 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!

Cheers

Greg Locock

Replies continue below

### RE: The need for speed: faster VBA

(OP)
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

### RE: The need for speed: faster VBA

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

### RE: The need for speed: faster VBA

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.

### RE: The need for speed: faster VBA

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

### RE: The need for speed: faster VBA

(OP)
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

### RE: The need for speed: faster VBA

Greg, is this algorithm some sort of binary search?

### RE: The need for speed: faster VBA

(OP)
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

### RE: The need for speed: faster VBA

(OP)

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

Cheers

Greg Locock

### RE: The need for speed: faster VBA

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

Best Regards

Morten

### RE: The need for speed: faster VBA

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.

#### Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

#### Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Close Box

# Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

• Talk To Other Members
• Notification Of Responses To Questions
• Favorite Forums One Click Access
• Keyword Search Of All Posts, And More...

Register now while it's still free!