How to improve VBA Code for Monte Carlo Simulation

0 votes

I created a piece of code to consolidate each individual Monte-Carlo Simulation result into a single sheet. After each iteration, the macro merely stores the values of rows B6:DS6 in an array and writes them below row 6 at the end of the Simulation Output(1) page.

Even if I'm not an expert in VBA, the calculations still take a while, taking, for example, 15 minutes for 10.000 iterations. Additionally, I frequently receive one of the following error messages when I attempt to run simulations that number more than 5.000.

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.

Jan 10, 2023 in Others by Kithuzzz
• 38,000 points
687 views

1 answer to this question.

0 votes

Try this:

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
answered Jan 10, 2023 by narikkadan
• 63,600 points

Related Questions In Others

+1 vote
1 answer

How to use VBA in Excel for Google Search?

Try this: Private Const LicenseRegistration As String = ...READ MORE

answered Oct 7, 2022 in Others by narikkadan
• 63,600 points
1,729 views
0 votes
1 answer

How to find a value in an excel column by vba code Cells.Find

Just use: Dim Cell As Range Columns("B:B").Select Set cell = ...READ MORE

answered Nov 17, 2022 in Others by narikkadan
• 63,600 points
3,797 views
0 votes
1 answer

How to programmatically code an 'undo' function in Excel-Vba?

Add the command button to the worksheet ...READ MORE

answered Nov 25, 2022 in Others by narikkadan
• 63,600 points
1,054 views
0 votes
1 answer

How to increment the Range of a For Each loop - Excel VBA

Your formula seems to sum 1 single ...READ MORE

answered Jan 7, 2023 in Others by narikkadan
• 63,600 points
2,754 views
0 votes
0 answers

Convert Rows to Columns with values in Excel using custom format

1 I having a Excel sheet with 1 ...READ MORE

Feb 17, 2022 in Others by Edureka
• 13,690 points
988 views
0 votes
1 answer

Remove formulas from all worksheets in Excel using VBA

Try this : Option Explicit Sub test1() ...READ MORE

answered Oct 3, 2022 in Others by narikkadan
• 63,600 points
2,063 views
0 votes
1 answer

Calculate monthly average from daily data without PivotTable

Assuming you have the months in column D enter ...READ MORE

answered Oct 3, 2022 in Others by narikkadan
• 63,600 points
1,781 views
0 votes
1 answer

Automate compound annual growth rate (CAGR) calculation

The following PowerPivot DAX formulas worked for ...READ MORE

answered Oct 7, 2022 in Others by narikkadan
• 63,600 points
1,293 views
0 votes
1 answer
0 votes
1 answer
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP