Way to speed up this newbie's simple recalc/copy/paste loop?

[kofgadol]

Hi all,

I've written a very basic macro (the only kind I know how!) which simulates the rolling of a die for a specified number of trials, recording each result as a hard-coded value in a table. It works fine but it is very slow. 1000 trials takes around 1.5 minutes. Yet I've seen other simulations in Excel go several times faster. Is there anything I can do to speed this up?

The code is below.

Basically, the user types in the number of trials in a cell named "Number_of_trials" and then runs the macro. Then, for each trial,

-- the die roll is simulated with a formula which uses the RAND function. This formula is in a cell named "ResultsLive". For each trial, the worksheet recalculates so that RAND generates a new value here.

-- the macro goes to this "ResultsLive" cell, copies the result, then goes to the top of the results table -- which is a cell named "FirstResults" -- and pastes it as a hard-coded value.

It then repeats as neccessary, storing each new result below the previous one, until the loop ends.

#######################################################
##################Code begins###########################

''' For the specified number of times, generates a random decimal between 0 and 1
''' and records it in a list

Dim i As Integer

For i = 0 To Range("Number_of_trials").Value
Calculate

Application.Goto Reference:="ResultsLive"
Selection.Copy
Application.Goto Reference:="FirstResults"
ActiveCell.Offset(i, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues

Next i

##################Code ends############################
#######################################################

My guess is that it's slow because the macro is literally "travelling" here and there many times as result of my use of "Goto Reference". Is there a quicker way to get each new, recalculated value to the proper destination cell?

[Logit]

I suspect because you are copying and pasting is slowing things down.

See if this is faster for you. Takes a different approach.

Option Explicit


Sub RollDice()
    Randomize
    Dim NextRow As Long
    Range("Die1") = Int(Rnd() * 6) + 1
    Range("Die2") = Int(Rnd() * 6) + 1
    NextRow = Range("A65536").End(xlUp).Row + 1
    If NextRow = Range("HistoryHeader").Row + 1 Then Cells(NextRow, 1) = 1 Else Cells(NextRow, 1) = Cells(NextRow - 1, 1) + 1
    Cells(NextRow, 2) = Range("Die1")
    Cells(NextRow, 3) = Range("Die2")
    Cells(NextRow, 4) = Range("Total")
End Sub


Sub ClearHistory()
    Range(Range("HistoryHeader").Offset(1, 0), Range("D65536")).Clear
End Sub

[mancubus]

welcome to the forum.
please take time to read the forum rules.
wrap your code with code tags (see my signature)

you don't need to select objects in order to work with them.

try this:

For i = 0 To Range("Number_of_trials").Value
    Calculate
    Range("FirstResults").Offset(i).Value = Range("ResultsLive").Value
Next i

[mancubus]

ooops
the thread had a reply whilst i was arranging the ranges in the OP's code.

[kofgadol]

Thank you very much mancubus, and sorry for the transgression

[Paul_Hossler]

I think you were over complicating it

This runs fast and I added a #Dice option to stress test it

As it is it returns 1 - 6, but change the ' comment line and it returns a floating point between 0 and 1

It's pretty straight forward and online help is good, but ask questions if you have any

Option Explicit

Sub RollDice()
    Dim iNumberRolls As Long, iNumberDice As Long, iRoll As Long, iDice As Long
    Dim rResultsStart  As Range
    Dim aRolls() As Double
    
    iNumberRolls = ActiveSheet.Range("A2").Value
    iNumberDice = ActiveSheet.Range("A5").Value
    Set rResultsStart = ActiveSheet.Range("B2")

    Application.ScreenUpdating = False

    For iDice = 1 To iNumberDice
        Range(rResultsStart, rResultsStart.End(xlDown)).Clear
        
        ReDim aRolls(1 To iNumberRolls)
        
        Randomize
        For iRoll = 1 To iNumberRolls
'           aRolls(iroll) = Rnd     '   0<=1
            aRolls(iRoll) = Int(6# * Rnd) + 1#      '   1-6
        Next iRoll
        
        rResultsStart.Resize(iNumberRolls, 1).Value = Application.WorksheetFunction.Transpose(aRolls)
    
        Set rResultsStart = rResultsStart.Offset(0, 1)
    Next iDice
    Application.ScreenUpdating = True
End Sub

[kofgadol]

welcome to the forum.
please take time to read the forum rules.
wrap your code with code tags (see my signature)

you don't need to select objects in order to work with them.

try this:

For i = 0 To Range("Number_of_trials").Value
    Calculate
    Range("FirstResults").Offset(i).Value = Range("ResultsLive").Value
Next i

You,sir,are a genius. That was exactly it. I'd wondered if there were a quicker way than literally copying and pasting all the time. You showed me that basically I could just link the source and destination with an equals sign. Before using your code, it took 86 seconds to run 1,000 trials; after, 15 seconds! Awesome. Thanks very much again.

[kofgadol]

How do I flag this as solved?

[Paul_Hossler]

Above post #1 is [Thread Tools] and one option is to mark SOLVED

As an aside, the macro in #6 did 10,000 'rolls' in < 1sec

The data might not have been in the same output format

[kofgadol]

Above post #1 is [Thread Tools] and one option is to mark SOLVED

As an aside, the macro in #6 did 10,000 'rolls' in < 1sec

The data might not have been in the same output format

Ok, I've flagged this as solved.


About the tip in #6 -- 10,000 in less than a second? Wow. I didn't try it as -- something I didn't mention -- I'm actually using this as a monte carlo simulator which can handle other types of probabilty functions (normal, lognormal, triangular etc) which in turn rely either on bundled Excel or custom user functions, which I would not know how to write in VBA; rather I'd just let the sheet recalc and then compile the results of each "live" distribution output cell. Is there a way I could apply your method to these functions? If so, that would be ... life-changing. Especially as this example is trivial, compared to the much larger models I do in real life.

[Paul_Hossler]

You might want to start another thread if you have different questions -- It makes it easier for people to see the new questions

1. If you're doing a lot of computation, it's faster to use arrays instead of putting and getting a lot of WS data

2. Planning ahead, you can use Excel's display capability to present the data

3. Here's something to think about. This generates normally distributed random data in an array. It puts the array on the worksheet for you to look at (B1:B***), but if all you might be interested in is the mean, you can compute that totally internally (A10 and A12)

4. Col D is a sort of the random Normal data in col B in order to make the graph

Capture.JPG

Option Explicit
Sub GenerateNormal()
    Dim iNumSamples As Long, i As Long
    Dim dMean As Double, dSigma As Double
    Dim rSamples As Range
    Dim a() As Double
    
    With Worksheets("Sheet2")
        iNumSamples = .Range("A2").Value
        dMean = .Range("A5").Value
        dSigma = .Range("A7").Value
        Set rSamples = .Range("B1")
        ReDim a(1 To iNumSamples)
    
        For i = 1 To iNumSamples
            a(i) = Application.WorksheetFunction.NormInv(Rnd, dMean, dSigma)
        Next I
        
        .Range("A10").Value = Application.WorksheetFunction.Average(a)
        .Range("A12").Value = Application.WorksheetFunction.StDev(a)
        
        rSamples.Resize(iNumSamples, 1).Value = Application.WorksheetFunction.Transpose(a)
        
    End With
    
End Sub