How can I speed up my VBA simulation??
I think there's a number of things you can do. An overview:
(1) Avoid looping through and making multiple read/writes to the
worksheet - use arrays instead. Example at foot of post. I think this is
most relevant to you and will drastically improve performance. I would
wager that if you do this you'll probably see a %50 or more reduction in
time to run.
(2) Every time you update the worksheet (for each of your writes, Excel
is updating the screen. Stop this with Application.ScreenUpdating =
False at the top of your code and then Application.ScreenUpdating = True
at the bottom. HANG ON - YOU'VE ALREADY DONE THIS HAVEN'T YOU.
APOLOGIES! (I'll leave this line in anyway as a general comment.)
(3) You may have other events firing in your Excel instance every time
you update a sheet. Make (careful) use of Application.EnableEvents =
False/True when making a write to prevent this. Be careful to always
switch it back on.
(4) There's no need to select and clear/copy ranges e.g.
Worksheets("Control").Range("D9:D11").Clear
Worksheets("Control").Range("C9:C11").Select
Selection.Copy
Worksheets("Control").Range("D9:D11").Select
etc.
Just to it directly as in:
Worksheets("Control").Range("D9:D11").Value = _
Worksheets("Control").Range("C9:C11").Value
or even
With worksheets("Control")
.Range("D9:D11").Value = .Range("C9:C11").Value
end with
Although since you don't do this often it won't really be hitting
performance.
(5) Place some code in your procedure like:
Debug.Print "Beginning Loop A" & vbtab & format(now, "nn:ss")
This will help you realise where the major bottlenecks are.
(6) Use With / End With when addressing the same object repeatedly e.g.
not:
For i = 1 To NumberOfFirms
AssetValue(i, 0) = InputData.Cells(i, 1).Value
Next i
but:
With InputData
For i = 1 To NumberOfFirms
AssetValue(i, 0) = .Cells(i, 1).Value
Next i
End with
(Example only.... I would use arrays anyway in this instance...)
(7) Update the Application.StatusBar at verious stages in the
procedure. OK - it won't speed things up but it at least shows you it's
doing something so might make it seem faster! Set to False at the
procedure end.
Back to point 1... Writing to and reading from the spreadsheet multiple
times can often *really* slow things down. I've done comparisons in the
past and been amazed at the results.
I wouldn't be bothered about the "one-offs" like:
NumberOfRuns = Worksheets("Control").Range("D1").Value
But things like:
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
involve 5000 separate reads which will definitely take a while.
I would load everything into an array and loop through that instead - I
think you'll be surprised at how much quicker it is.
For example, this isn't exactly how I would do it but as a quick amendment:
Dim InputData As Range, arrInputData as Variant
Dim OutputData As Range, arrOutputData as Variant
Set InputData = Worksheets("InputDataSheet").Range("C3:G1002")
'Load the entire range into an array
arrInputData = InputData
Set OutputData = Worksheets("OutputDataSheet").Range("C3:C1002")
Outputdata.clear
arrOutputData = OutputData 'a lazy way of dimensioning
'the output array
'then, in your loop, read the array rather than the worksheet
For i = 1 To NumberOfFirms
AssetValue(i, 0) = arrInputData(i, 1)
DefaultPoint(i, 0) = arrInputData(i, 2)
AssetVolatility(i, 0) = arrInputData(i, 3)
DriftROA(i, 0) = arrInputData(i, 4)
DividendYield(i, 0) = arrInputData(i, 5)
TimeIncrement(i, 0) = 1 / NumberOfRuns
Next i
When you need to write back to the worksheet you should do something like:
'load up the output into our output array
For i = 1 To NumberOfFirms
arrOutputData (i, 1) = DefaultRate(i)
Next i
'Write all your data back in one fell swoop rather than piecemeal.
OutputData = arrOutputData
That's about it. I hope this helps.
Gman
Andy wrote:
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
|