How to improve VBA Code for Monte Carlo Simulation?

Question

I have written a code to store the indiviual results of a Monte-Carlo Simulation in one sheet. What the Macro does is basically store the values of B6:DS6 in the Simulation Output(1) sheet after each iteration in an array and write them finally below the row 6.

I am not an expert in VBA but I notice that the calculations still take rather long, e.g. 15 Minutes for 10.000 iterations. Also when I try to run Simulations more than 5.000 I very often get either of the followng eror messages below.

Error Message 1 or Error Message 2

any help on the error and ideas on how to make the code faster would be much appreciated! Thanks in advance! Oscar

Sub MC_Sim()


'Varianblendeklaration
Dim Arr
Dim Outp
Dim i As Integer
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim MyTimer As Double


'Funktionen Aus
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Simulation Output (2)").EnableCalculation = False
Sheets("Grafiken").EnableCalculation = False


'Timer für Simulationszeit
StartTime = Timer


'Szenario auf Monte Carlo Simulation setzen
Sheets("Annahmen").Select
    Range("F41").Select
    Range("F41").Value = "Monte Carlo Simulation"


'Löschen vorhandener Werte in Outputsheet
Sheets("Simulation Output (1)").Select
    Range("B7:DS7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    

'Kopieren und Output der Simulationswerte in Schleife über ein Array als Zwischenpspeicher
ReDim Outp(1 To Range("C1").Value, 1 To Range("B6:DS6").Columns.Count)

    For i = 1 To Range("C1")
        Arr = Range("B6:DS6").Value
        For S = 1 To UBound(Arr, 2)
           Outp(i, S) = Arr(1, S)
    Next
    
'Neuberechnung der Planzufallswerte in B6:DS6
Calculate
            
'Ausgabe Stausbar
SecondsElapsed = Round(Timer - StartTime, 2)
Application.StatusBar = "Simulation aktiv... I Fortschritt: " & i - 1 & " von " & Range("C1") & " Iterationen (" _
& Format((i - 1) / Range("C1"), "0%") & ") I Rechenzeit (Min:Sek): " & Format(SecondsElapsed / 60 / 60 / 24, "nn:ss")
    
Next
        
'Zurückschreiben der Werte aus dem Array in das Tabellenblatt
Range("B7").Resize(UBound(Outp, 1), UBound(Outp, 2)) = Outp


'Simulationszeit in Sekunden
Sheets("Simulation Output (1)").Select
    Range("C2").Value = SecondsElapsed


'Szenario zurück auf Base Case
Sheets("Annahmen").Select
    Range("F41").Select
    Range("F41").Value = "Base Case"


'Simulationszeit in Sekunden
Sheets("Simulation Output (1)").Select
        SecondsElapsed = Round(Timer - StartTime, 2)
        Range("C2").Value = SecondsElapsed

'Hinweis
MsgBox "Ende der Simulation! Rechenzeit (Min:Sek): " & Format(SecondsElapsed / 60 / 60 / 24, "nn:ss")


'Funktionen An
Application.ScreenUpdating = True
Application.EnableEvents = True
Sheets("Simulation Output (2)").EnableCalculation = True
Sheets("Grafiken").EnableCalculation = True


'Zurücksetzen der Statusleiste und Löschen des Clipboards
Application.StatusBar = False
Application.CutCopyMode = False

End Sub

See Code above, however the Code is still slow and I get error messages for higher iterations.

https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — braX, Jan 08 '23 at 22:57
If you have working code that you want to have peer reviewed for improvements, you should be asking at [codereview.se], which was created just for that purpose. This site is for questions about non-working code. — Ken White, Jan 08 '23 at 23:24
[Consider using long instead of integer](https://stackoverflow.com/a/51689021/11732320) — pgSystemTester, Jan 09 '23 at 09:09
Welcome Oscar! Please take some time to read the introduction to Stack Overflow and earn your next badge. https://stackoverflow.com/tour — user10186832, Jan 09 '23 at 11:13

score 0 · Answer 1 · answered Jan 09 '23 at 20:04

This is working for me: Give it a try!

Option Explicit
Sub MC_Sim()
    
    'Varianblendeklaration
    Dim Arr
    Dim Outp
    Dim I As Long
    Dim S As Long
    Dim Lrow As Long
    Dim Xval As Long
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    Dim MyTimer As Double
    
    'Funktionen Aus
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    'Timer für Simulationszeit
    StartTime = Timer
    
    'Szenario auf Monte Carlo Simulation setzen
    Sheets("Annahmen").Range("F41").Value = "Monte Carlo Simulation"

    'Löschen vorhandener Werte in Outputsheet
    With Sheets("Simulation Output (1)")
        Lrow = .Range("B7").End(xlDown).Row
        .Range("B7:DS" & Lrow).ClearContents
            
        'Kopieren und Output der Simulationswerte in Schleife über ein Array als Zwischenpspeicher
        Xval = .Range("C1").Value
        ReDim Outp(1 To Xval, 1 To .Range("B6:DS6").Columns.Count)
        
        For I = 1 To Xval
            Arr = .Range("B6:DS6")
            For S = 1 To UBound(Arr, 2)
               Outp(I, S) = Arr(1, S)
            Next S
                
            'Neuberechnung der Planzufallswerte in B6:DS6
            Calculate
                        
            'Ausgabe Stausbar
            SecondsElapsed = Round(Timer - StartTime, 2)
            Application.StatusBar = "Simulation aktiv... I Fortschritt: " & I - 1 & " von " & Xval & " Iterationen (" _
            & Format((I - 1) / Xval, "0%") & ") I Rechenzeit (Min:Sek): " & Format(SecondsElapsed / 60 / 60 / 24, "nn:ss")
                
        Next I
                
        'Zurückschreiben der Werte aus dem Array in das Tabellenblatt
        .Range("B7").Resize(UBound(Outp, 1), UBound(Outp, 2)) = Outp
        
        'Simulationszeit in Sekunden
        .Range("C2").Value = SecondsElapsed
        
        'Szenario zurück auf Base Case
        Sheets("Annahmen").Range("F41").Value = "Base Case"
        
        'Simulationszeit in Sekunden
        SecondsElapsed = Round(Timer - StartTime, 2)
        .Range("C2").Value = SecondsElapsed
        
        'Hinweis
        MsgBox "Ende der Simulation! Rechenzeit (Min:Sek): " & Format(SecondsElapsed / 60 / 60 / 24, "nn:ss")
        
    End With
    
    'Funktionen An
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    'Zurücksetzen der Statusleiste und Löschen des Clipboards
    Application.StatusBar = False
    Application.CutCopyMode = False

End Sub

Many thanks! That works! Much obliged! – Oscar Jan 12 '23 at 20:07 — Oscar, Jan 12 '23 at 20:07

How to improve VBA Code for Monte Carlo Simulation?

1 Answers1