×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Contact US

*
*
*
*

Thanks. We have received your request and will respond promptly.

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • 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.

Students Click Here

The need for speed: faster VBA
3

thread770-56303

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!

Cheers

Greg Locock

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

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.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members! Already a Member? Login

Resources

Low-Volume Rapid Injection Molding With 3D Printed Molds
Learn methods and guidelines for using stereolithography (SLA) 3D printed molds in the injection molding process to lower costs and lead time. Discover how this hybrid manufacturing process enables on-demand mold fabrication to quickly produce small batches of thermoplastic parts. Download Now
Design for Additive Manufacturing (DfAM)
Examine how the principles of DfAM upend many of the long-standing rules around manufacturability - allowing engineers and designers to place a part’s function at the center of their design considerations. Download Now
Taking Control of Engineering Documents
This ebook covers tips for creating and managing workflows, security best practices and protection of intellectual property, Cloud vs. on-premise software solutions, CAD file management, compliance, and more. Download Now
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:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close