plotting Monte Carlo Simulation from excel sheet

Question

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($B4,ドル$B5,ドル$B6,ドル$B9,ドル$B8,ドル$B7,ドル$B10,ドル$G7,ドル$A13ドル)"
'FOR 1000 simulations Range("B" & StartingCell, "B" & LastCell).Formula = "=EuropeanOption2($B4,ドル$B5,ドル$B6,ドル$B9,ドル$B8,ドル$B7,ドル$B10,ドル$G7,ドル$B13ドル)"
'For 10.000 simulations Range("C" & StartingCell, "C" & LastCell).Formula = "=EuropeanOption2($B4,ドル$B5,ドル$B6,ドル$B9,ドル$B8,ドル$B7,ドル$B10,ドル$G7,ドル$C13ドル)"
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.

• Tim Williams: FYI WorksheetFunction.Max(St - Strike, 0) is a lot slower than IIf(St - Strike > 0, St - Strike, 0)

Answer 1

Monte Carlo Simulation

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

enter image description here

• 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 NinthAddrList As String = "A13,B13,C13" ' add more
 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 EightsAddr() As String: EightsAddr = Split(EightsAddrList, ",")
 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
 eArr(e) = ws.Range(EightsAddr(e)).Value
 Next e
 Erase EightsAddr
 
 ' Ninth argument
 Dim NinthAddr() As String: NinthAddr = Split(NinthAddrList, ",")
 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
 With ws.Range(NinthAddr(n))
 NinthVals(n) = .Value
 NinthCols(n) = .Column
 End With
 Next n
 Erase NinthAddr
 
 ' 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