Hi all

I tried several tricks to simplify my VBA codes for running a Monte
Carlo simulation in an efficient fashion. My goal is to runs at least
10,000 simulation trials each of which has at least 250 runs (or
trading days). I wonder if you could advise on how to speed up this
Monte Carlo simulation such that I can use these codes to obtain the
results for 9,000 observations (or companies).

This simulation applies a variant of Robert Merton's (1974)
option-pricing model to derive the probability of default for a given
company. Thanks very much for your help!!

Kind Regards,

Andy

The VBA codes are as follows:


Option Explicit
Option Base 1

Sub MonteCarlo()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Worksheets("Control").Range("D9:D11").Clear
Worksheets("Control").Range("C9:C11").Select
Selection.Copy
Worksheets("Control").Range("D9:D11").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False

Worksheets("Control").Range("starttime") = Time
Worksheets("Control").Range("starttime").NumberFor mat = "dd:hh:mm:ss"

Dim NumberOfRuns As Integer
Dim NumberOfTrials As Integer
Dim NumberOfFirms As Integer

NumberOfRuns = Worksheets("Control").Range("D1").Value
NumberOfTrials = Worksheets("Control").Range("D2").Value

'Need to set the number of firms in a manual manner!!
NumberOfFirms = 1000

Dim i As Integer
Dim j As Integer
Dim k As Integer

Dim InputData As Range
Dim OutputData As Range

Set InputData = Worksheets("InputDataSheet").Range("C3:G1002")
Set OutputData = Worksheets("OutputDataSheet").Range("C3:C1002")

'Dim Plot As Range
'Set Plot = Worksheets("Sheet4").Range("B1:K10")

Dim RandomNumbers, AssetValue, AssetValueChange, RawDefault,
CumulativeRawDefault, Default, CumulativeDefault, DefaultRate
ReDim RandomNumbers(1 To NumberOfFirms, 1 To NumberOfRuns) As
Double

ReDim AssetValue(1 To NumberOfFirms, 0 To NumberOfRuns) As
Double
ReDim AssetValueChange(1 To NumberOfFirms, 1 To NumberOfRuns)
As Double

ReDim DefaultPoint(1 To NumberOfFirms, 0 To NumberOfRuns) As
Double
ReDim AssetVolatility(1 To NumberOfFirms, 0 To NumberOfRuns) As
Double
ReDim DriftROA(1 To NumberOfFirms, 0 To NumberOfRuns) As Double
ReDim DividendYield(1 To NumberOfFirms, 0 To NumberOfRuns) As
Double
ReDim TimeIncrement(1 To NumberOfFirms, 0 To NumberOfRuns) As
Double

ReDim RawDefault(1 To NumberOfFirms, 1 To NumberOfRuns) As
Double
ReDim CumulativeRawDefault(1 To NumberOfFirms, 0 To
NumberOfRuns) As Double

ReDim Default(1 To NumberOfFirms, 1 To NumberOfTrials) As
Double
ReDim CumulativeDefault(1 To NumberOfFirms, 0 To
NumberOfTrials) As Double

ReDim DefaultRate(1 To NumberOfFirms) As Single


Randomize
For i = 1 To NumberOfFirms
For j = 1 To NumberOfRuns
RandomNumbers(i, j) = Rnd()
Next j
Next i


For k = 1 To NumberOfTrials

For i = 1 To NumberOfFirms
AssetValue(i, 0) = InputData.Cells(i, 1).Value
DefaultPoint(i, 0) = InputData.Cells(i, 2).Value
AssetVolatility(i, 0) = InputData.Cells(i, 3).Value
DriftROA(i, 0) = InputData.Cells(i, 4).Value
DividendYield(i, 0) = InputData.Cells(i, 5).Value
TimeIncrement(i, 0) = 1 / NumberOfRuns
Next i


For i = 1 To NumberOfFirms
For j = 1 To NumberOfRuns
DefaultPoint(i, j) = DefaultPoint(i, 0)
DriftROA(i, j) = DriftROA(i, 0)
DividendYield(i, j) = DividendYield(i, 0)
AssetVolatility(i, j) = AssetVolatility(i, 0)
TimeIncrement(i, j) = TimeIncrement(i, 0)
Next j
Next i


For i = 1 To NumberOfFirms
For j = 1 To NumberOfRuns
AssetValueChange(i, j) = Application.NormInv(RandomNumbers(i,
j), (DriftROA(i, j) - DividendYield(i, j)) * AssetValue(i, j - 1) *
TimeIncrement(i, j), AssetVolatility(i, j) * AssetValue(i, j - 1) *
Sqr(TimeIncrement(i, j)))
AssetValue(i, j) = AssetValue(i, j - 1) + AssetValueChange(i,
j)
Next j
Next i


For i = 1 To NumberOfFirms
CumulativeRawDefault(i, 0) = 0
Next i

For i = 1 To NumberOfFirms
For j = 1 To NumberOfRuns
If AssetValue(i, j) < DefaultPoint(i, j) Then
RawDefault(i, j) = 1
Else
RawDefault(i, j) = 0
End If
Next j
Next i


For i = 1 To NumberOfFirms
For j = 1 To NumberOfRuns
CumulativeRawDefault(i, j) = CumulativeRawDefault(i, j - 1) +
RawDefault(i, j)
Next j
Next i

For i = 1 To NumberOfFirms
If CumulativeRawDefault(i, NumberOfRuns) 0 Then
Default(i, k) = 1
Else
Default(i, k) = 0
End If
Next i

Worksheets("Control").Range("elapsed") = Time -
Worksheets("Control").Range("starttime")
Range("elapsed").NumberFormat = "dd:hh:mm:ss"

Worksheets("Control").Range("D20") = k


Next k


For i = 1 To NumberOfFirms
CumulativeDefault(i, 0) = 0
Next i

For i = 1 To NumberOfFirms
For k = 1 To NumberOfTrials
CumulativeDefault(i, k) = CumulativeDefault(i, k - 1) +
Default(i, k)
Next k
Next i

For i = 1 To NumberOfFirms
DefaultRate(i) = CumulativeDefault(i, NumberOfTrials) /
NumberOfTrials
Next i

For i = 1 To NumberOfFirms
OutputData.Cells(i, 1) = DefaultRate(i)
Next i


Worksheets("Control").Range("stoptime") = Time
Worksheets("Control").Range("stoptime").NumberForm at = "dd:hh:mm:ss"

Application.Calculation = xlCalculationAutomatic

End With
End Sub