# plotting Monte Carlo Simulation from excel sheet

I have created the following code:

Option Explicit

Function EuropeanOption2(OptionType As String, Spot As Double, Strike As Double, RiskFreeInterest As Double, Volatility As Double, TimetoMaturity As Double, Dividend As Double, n As Double, Iterations As Double)
Dim m As Integer
Dim p As Integer
Dim OptionPayoff() As Double, St As Double, deltat As Double, random As Double, EuropeanOptionPrice As Double

ReDim Payoff(1 To Iterations)

deltat = TimetoMaturity / n

Randomize

For m = 1 To Iterations
St = Spot
For p = 1 To n
random = WorksheetFunction.NormSInv(Rnd())
St = St * Exp((RiskFreeInterest - Dividend - volatility ^ 2 / 2) * deltat + Volatility * Sqr(deltat) * random)
Next p

If OptionType = "Call" Then 'Call or Put
Payoff(m) = WorksheetFunction.Max(St - Strike, 0) * Exp(-RiskFreeInterest * TimetoMaturity)
ElseIf OptionType = "Put" Then
Payoff(m) = WorksheetFunction.Max(Strike - St, 0) * Exp(-RiskFreeInterest * TimetoMaturity)
End If
Next m

For m = 1 To Iterations
EuropeanOptionPrice = EuropeanOptionPrice + Payoff(m)
Next m

EuropeanOption2 = EuropeanOptionPrice / Iterations

End Function

Sub Graph2()

Dim Column As Integer
Dim StartingValue As Integer
Dim StartingCell As Integer
Dim LastCell As Integer
Dim CallorPut As String
Dim cell As Integer

Application.ScreenUpdating = False

Application.Calculation = xlManual

Column = 1
StartingValue = 1
StartingCell = 15
LastCell = 15 + Range("G8")

Range("A" & StartingCell, "A" & LastCell).Formula = "=EuropeanOption2($B$4,$B$5,$B$6,$B$9,$B$8,$B$7,$B$10,$G$7,$A$13)"

'FOR 1000 simulations Range("B" & StartingCell, "B" & LastCell).Formula = "=EuropeanOption2($B$4,$B$5,$B$6,$B$9,$B$8,$B$7,$B$10,$G$7,$B$13)"

'For 10.000 simulations Range("C" & StartingCell, "C" & LastCell).Formula = "=EuropeanOption2($B$4,$B$5,$B$6,$B$9,$B$8,$B$7,$B$10,$G$7,$C$13)"

End Sub


As it takes forever to put in formulas for 1000 & 10.000+ simulations, I wanted to ask how to store the results in an array and plot these in the excel sheet and if this could help to speed up to computing process.

• FYI WorksheetFunction.Max(St - Strike, 0) is a lot slower than IIf(St - Strike > 0, St - Strike, 0) Sep 21, 2022 at 17:56

## Monte Carlo Simulation

• The code took 8s to produce the result (A15:C34) in the screenshot.

• If you put all hard-coded values in constants at the beginning of the code, you'll know where to quickly find and modify them.
• Put all the values in variables and in data structures (only arrays here) and in the loop use them to 'feed' the function.
• Write the results to a 2D one-based one-column array to easily drop them in the one-column range. I didn't use one array with 3 columns to allow non-adjacent columns.
• I used Tim Williams' tip from the comments to modify the logic in the function a little bit.
• Unfortunately, I am Monte Carlo illiterate and have no clue what kind of numbers are to be used.
• In my short testing, when I used n = 200, it took forever, and finally WorksheetFunction.NormSInv failed which also failed once before. Maybe you ought to do something about it.

The Sub

Sub Graph2()
Const ProcName As String = "Graph2"
On Error GoTo ClearError

Dim dT As Double: dT = Timer

Const RowsCountAddress As String = "G8"
Const EightsAddrList As String = "B4,B5,B6,B9,B8,B7,B10,G7"
Const FirstRow As Long = 15

Dim ws As Worksheet: Set ws = ActiveSheet ' improve!

Dim rCount As Long: rCount = ws.Range(RowsCountAddress).Value

' Store the lists and the values from the cells in arrays.

' First 8 arguments
Dim eUpper As Long: eUpper = UBound(EightsAddr)

Dim eArr() As Variant: ReDim eArr(0 To eUpper)

Dim e As Long
For e = 0 To eUpper
Next e

' Ninth argument
Dim nUpper As Long: nUpper = UBound(NinthAddr)

Dim NinthVals() As Long: ReDim NinthVals(0 To nUpper)
Dim NinthCols() As Long: ReDim NinthCols(0 To nUpper)

Dim n As Long
For n = 0 To nUpper
NinthVals(n) = .Value
NinthCols(n) = .Column
End With
Next n

' Return the results in columns.

Dim cData() As Double: ReDim cData(1 To rCount, 1 To 1)

Dim crg As Range
Dim r As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For n = 0 To nUpper
For r = 1 To rCount
cData(r, 1) = EuropeanOption2(eArr(0), eArr(1), eArr(2), eArr(3), _
eArr(4), eArr(5), eArr(6), eArr(7), NinthVals(n))
Next r
With ws.Cells(FirstRow, NinthCols(n)).Resize(rCount)
.Value = cData ' write
.Resize(ws.Rows.Count - .Row - rCount + 1).Offset(rCount).Clear
End With
Next n

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

' Inform.
MsgBox "Monte Carlo time: " & Format(Timer - dT, "0.000s."), vbInformation

ProcExit:
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & "    " & Err.Description
Resume ProcExit
End Sub


The Function

Function EuropeanOption2( _
ByVal OptionType As String, _
ByVal Spot As Double, _
ByVal Strike As Double, _
ByVal RiskFreeInterest As Double, _
ByVal Volatility As Double, _
ByVal TimetoMaturity As Double, _
ByVal Dividend As Double, _
ByVal n As Long, _
ByVal Iterations As Long) _
As Double
Const ProcName As String = "EuropeanOption2"
On Error GoTo ClearError

Dim Deltat As Double: Deltat = TimetoMaturity / n

Dim m As Long
Dim p As Long

Dim St As Double
Dim Random As Double
Dim PayOff As Double
Dim EuropeanOptionPrice As Double

Randomize

For m = 1 To Iterations
St = Spot
PayOff = 0

For p = 1 To n
Random = WorksheetFunction.NormSInv(Rnd())
St = St * Exp((RiskFreeInterest - Dividend - Volatility ^ 2 / 2) _
* Deltat + Volatility * Sqr(Deltat) * Random)
Next p

Select Case OptionType
Case "Call"
If St > Strike Then
PayOff = (St - Strike) * Exp(-RiskFreeInterest * TimetoMaturity)
End If
Case "Put"
If Strike > St Then
PayOff = (Strike - St) * Exp(-RiskFreeInterest * TimetoMaturity)
End If
Case Else ' oops
End Select

EuropeanOptionPrice = EuropeanOptionPrice + PayOff
Next m

EuropeanOption2 = EuropeanOptionPrice / Iterations

ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & "    " & Err.Description
Resume ProcExit
End Function