Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How can I speed up my VBA simulation??
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
How can I speed up my VBA simulation??
Multiple Dims don't work that way.
This: Dim RandomNumbers, AssetValue, AssetValueChange, RawDefault, CumulativeRawDefault, Default, CumulativeDefault, DefaultRate ReDim RandomNumbers(1 To NumberOfFirms, 1 To NumberOfRuns) As Double Will Dim RandomNumbers as double and all the others as Variant. I wouldn't be surprised if changing just that increases your speed sufficiently -- Kind regards, Niek Otten "Andy" wrote in message ups.com... 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
How can I speed up my VBA simulation??
Sorry, should have read further; probably the ReDimming corrects this
-- Kind regards, Niek Otten "Niek Otten" wrote in message ... Multiple Dims don't work that way. This: Dim RandomNumbers, AssetValue, AssetValueChange, RawDefault, CumulativeRawDefault, Default, CumulativeDefault, DefaultRate ReDim RandomNumbers(1 To NumberOfFirms, 1 To NumberOfRuns) As Double Will Dim RandomNumbers as double and all the others as Variant. I wouldn't be surprised if changing just that increases your speed sufficiently -- Kind regards, Niek Otten "Andy" wrote in message ups.com... 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
How can I speed up my VBA simulation??
As a caveat to my <you'll probably see a %50 or more reduction in time
to run claim. That goes only for the sections where you're reading to and from the worksheet. Obviously it won't affect things like: 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 Depending on the NumberOfRuns this could of course take an age. If you want to hone the code mathematically.... I ain't your man! Gman wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
I need to set up a simulation | Setting up and Configuration of Excel | |||
Can you help me create this simulation | Excel Discussion (Misc queries) | |||
revenue simulation | Excel Discussion (Misc queries) | |||
Car assign simulation | Excel Worksheet Functions | |||
Car assign simulation | Excel Programming |