Stock simulation - slow VBA

[mrbojangles92]

Hey,

I am currently trying to create a code that will allow me to simulate stock price changes each day (252 days) for 5-10 years. Each change results in a fee being paid if the stock has increased since all previous stock prices.
As a result each simulation is in a separate row, each day has 7 columns which shows outputs such as new stock price, high water mark (highest stock price), index (compared to FTSE), and outputs to generate the fee. I am running 10,000 simultations so all in all there is 10,000 rows and 1766 columns to be reviewed each year.


My initial idea was to run a For..Next Loop looking through each row separately, within this loop to run a further For...Next Loop with Step 7, running through the column sections. So the simulation on the first row calculates the values across all values before starting a new row.
Within this For..Next loop for columns are multiple Max value functions so I am currently trying to create a custom function to do this without having to access the application.worksheetfunction.max from excel.

Currently it takes 30 mins to run the first year simulation so I was trying to speed things up before moving onto other years. I am currently trying to clean up my code but wondered if anyone had any suggestions as how to speed things up i.e not needing the loops?

Any suggestions welcome!

Thanks!

 

[igold]

Hi mrbojangles92

Welcome to the Forum.

It would be helpful to see your current code to be able to pinpoint the areas where effeciencies can be gained. Also a small representative sample of your data would be helpful as well.

 

[mrbojangles92]

[TABLE="width: 500"]
<tbody>[TR]
[TD]S0[/TD]
[TD]HWM0[/TD]
[TD]Hurdle0[/TD]
[TD]Option0[/TD]
[TD]Discounted Option0[/TD]
[TD]Performance Fee0[/TD]
[TD]S0*[/TD]
[TD]S1[/TD]
[TD]HWM1[/TD]
[TD]Hurdle1[/TD]
[TD]Option1[/TD]
[TD]Discounted1[/TD]
[TD]PF1[/TD]
[TD]S*1[/TD]
[TD]S2[/TD]
[TD]HWM2[/TD]
[TD]Hurdle2[/TD]
[TD]Option2[/TD]
[TD]Discounted2[/TD]
[TD]PF2 [/TD]
[TD]S*2[/TD]
[/TR]
[TR]
[TD]50[/TD]
[TD]50[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]50[/TD]
[TD]49.93[/TD]
[TD]50[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]49.93[/TD]
[TD]50.24[/TD]
[TD]50[/TD]
[TD]0[/TD]
[TD]0.24[/TD]
[TD]0.24[/TD]
[TD]0.05[/TD]
[TD]50.24[/TD]
[/TR]
[TR]
[TD]50[/TD]
[TD]50[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]50[/TD]
[TD]50.22[/TD]
[TD]50[/TD]
[TD]0[/TD]
[TD]0.22[/TD]
[TD]0.22[/TD]
[TD]0.04[/TD]
[TD]50.22[/TD]
[TD]50.29[/TD]
[TD]50.22[/TD]
[TD]0[/TD]
[TD]0.07[/TD]
[TD]0.07[/TD]
[TD]0.01[/TD]
[TD]50.29[/TD]
[/TR]
</tbody>[/TABLE]

Time 0 values are all 0 for the 0 values and the S0 and HWM0 values are always the initial stock value which is inputted by the user and populates all the simulations as a result.
For these results the inputs were:
S0 50
r= 5%
volatility = 10%
time = 1/252 (one day)
discount = 0.25
Proportion of option as performance Fee = 20%
AMC = 1%

Sub Dailystockchange()
 Dim cPrevStock As Currency
 Dim cPrevHWM As Currency
 Dim dRiskFree As Double
 Dim dVolatility As Double
 Dim dTime As Double
 Dim lSimulations As Long
 Dim lSimulationNumber As Long
 Dim cStock As Currency
 Dim cOptionPrice As Currency
 Dim cDiscOption As Currency
 Dim lRow As Long
 Dim lCol As Integer
 Dim dDiscount As Double
 Dim dPerfFee As Double
 Dim dAMC As Double
 Dim sBenchset As String
 Dim cHWM As Currency
 Dim cHurdle As Currency
 Dim dGrowth As Double
 Dim dFTSE As Double
 Dim cMaxHWMHR As Currency
 Dim cPF As Currency
 Dim cPrevPF As Currency
 Dim cTotalPF As Currency
 Dim cStockAdj As Currency
 Dim cFinalStock As Currency
 Dim cAMC As Currency
 Dim cFinalFund As Currency
 dRiskFree = Cells(4, 2)
 dVolatility = Cells(5, 2)
 dTime = Cells(6, 2)
 lSimulations = Cells(8, 2)
 dDiscount = Cells(3, 5)
 sBenchset = Cells(8, 5)
 dGrowth = Cells(3, 9)
 dPerfFee = Cells(4, 5)
 dAMC = Cells(5, 5)
 Call OptimizeCode_Begin
 x = lSimulations + 11
 For lRow = 12 To x
     For lCol = 9 To 1772 Step 7
         
         cPrevStock = Cells(lRow, (lCol - 1))
         cPrevHWM = Cells(lRow, (lCol - 6))
         cStock = cPrevStock * Exp((dRiskFree - ((dVolatility ^ 2) * 0.5)) * dTime + dVolatility * Application.WorksheetFunction.NormSInv(Rnd) * (dTime ^ 0.5))
     
         Cells(lRow, (lCol)) = cStock
     
         If cPrevStock > cPrevHWM Then
             cHWM = cPrevStock
         Else
            cHWM = cPrevHWM
         End If
            
         Cells(lRow, (lCol + 1)) = cHWM
     
         If sBenchset = "Follow stock" Then
             cHurdle = 0
         ElseIf sBenchset = "Constant Growth" Then
             cHurdle = cPrevHWM * (1 + dGrowth)
         ElseIf sBenchset = "Follow index" Then
             dFTSE1 = Cells(9, lCol)
             cHurdle = cPrevHWM * (1 + dFTSE1)
         End If
                 
         Cells(lRow, (lCol + 2)) = cHurdle
             
         If cHWM > cHurdle Then
             cMaxHWMHR = cHWM
         Else:
             cMaxHWMHR = cHurdle
         End If
         
         If cStock > cMaxHWMHR Then
             cOptionPrice = cStock - cMaxHWMHR
         Else
             cOptionPrice = 0
         End If
         
         Cells(lRow, (lCol + 3)) = cOptionPrice
     
         cDiscOption = cOptionPrice * Exp(-(dDiscount) * dTime)
     
         Cells(lRow, (lCol + 4)) = cDiscOption
     
         cPF = dPerfFee * cDiscOption
         cPrevPF = Cells(lRow, (lCol - 2))
         
         If lCol = 9 Then
             cTotalPF = cPF
         Else:
             cTotalPF = cPF + cTotalPF
         End If
         
     Cells(lRow, (lCol + 5)) = cPF
         
        If lCol = 1766 Then
             cStockAdj = cStock - cTotalPF
         Else:
             cStockAdj = cStock
         End If
            
         Cells(lRow, (lCol + 6)) = cStockAdj
     
     Next lCol
   
     cFinalStock = Cells(lRow, 1772)
     cAMC = cFinalStock * dAMC
     Cells(lRow, 1773) = cAMC
     cFinalFund = cFinalStock - cAMC
     Cells(lRow, 1774) = cFinalFund
 Next lRow

 Call OptimizeCode_End

 End Sub

Apologies I am sure it is very inefficient and could be laid out better but I've tried to indent where I think it makes sense so hope it's still ok for you to read!
The above code now takes 20 minutes to complete 10,000 simulations which is better. Initially I thought maybe the line:

cStock = cPrevStock * Exp((dRiskFree - ((dVolatility ^ 2) * 0.5)) * dTime + dVolatility * Application.WorksheetFunction.NormSInv(Rnd) * (dTime ^ 0.5))

Was the problem due to Normsinv but when I made that a constant it took 17 minutes so don't think it is that much of a problem.

Thanks anyway!

 

[igold]

Hi,

This is really a shot in the dark. IMHO one of your problems is that you constantly going to the worksheet to get and write values. Doing that is really time consuming and inefficient.
I have tried to create an array that will hold the current set of calculations on the row in memory and then write them all at once before moving on to lcol + 7. The way I interpreted it, it looks like you have a blank column in between sets.

If this comes close to working I will be amazed. I am assuming that the two subs you are calling are doing things like turning off/on ScreenUpdating and Calculations. Let's see how it goes...

Sub Dailystockchange()


    Dim cPrevStock As Currency, cPrevHWM As Currency, cStock As Currency, cOptionPrice As Currency
    Dim dRiskFree As Double, dVolatility As Double, dTime As Double, dDiscount As Double, dPerfFee As Double
    Dim lSimulations As Long, lSimulationNumber As Long, lRow As Long, x As Long
    Dim cDiscOption As Currency, cHWM As Currency, cHurdle As Currency
    Dim lCol As Integer
    Dim dAMC As Double, dGrowth As Double, dFTSE As Double, dFTSE1 As Double
    Dim sBenchset As String
    Dim cMaxHWMHR As Currency, cPF As Currency, cPrevPF As Currency, cTotalPF As Currency
    Dim cStockAdj As Currency, cFinalStock As Currency, cAMC As Currency, cFinalFund As Currency
    Dim stockcols As Variant
    
    dRiskFree = Cells(4, 2)
    dVolatility = Cells(5, 2)
    dTime = Cells(6, 2)
    lSimulations = Cells(8, 2)
    dDiscount = Cells(3, 5)
    sBenchset = Cells(8, 5)
    dGrowth = Cells(3, 9)
    dPerfFee = Cells(4, 5)
    dAMC = Cells(5, 5)
    Call OptimizeCode_Begin
    x = lSimulations + 11
    For lRow = 12 To x
        'For lCol = 9 To 1772 Step 7
        lCol = 9
NextSet:
            stockcols = Range(Cells(lRow, lCol), Cells(lRow, lCol + 5))
            cPrevStock = Cells(lRow, (lCol - 1))
            cPrevHWM = Cells(lRow, (lCol - 6))
            cStock = cPrevStock * Exp((dRiskFree - ((dVolatility ^ 2) * 0.5)) * dTime + dVolatility * Application.WorksheetFunction.NormSInv(Rnd) * (dTime ^ 0.5))
            'Cells(lRow, (lCol)) = cStock
            stockcols(1, 1) = cStock
            
            If cPrevStock > cPrevHWM Then
                cHWM = cPrevStock
            Else
                cHWM = cPrevHWM
            End If
            'Cells(lRow, (lCol + 1)) = cHWM
            stockcols(1, 2) = cHWM
            
            If sBenchset = "Follow stock" Then
                cHurdle = 0
            ElseIf sBenchset = "Constant Growth" Then
                cHurdle = cPrevHWM * (1 + dGrowth)
            ElseIf sBenchset = "Follow index" Then
                dFTSE1 = Cells(9, lCol)
                cHurdle = cPrevHWM * (1 + dFTSE1)
            End If
            'Cells(lRow, (lCol + 2)) = cHurdle
            stockcols(1, 3) = cHurdle


            If cHWM > cHurdle Then
                cMaxHWMHR = cHWM
            Else:
                cMaxHWMHR = cHurdle
            End If
         
            If cStock > cMaxHWMHR Then
                cOptionPrice = cStock - cMaxHWMHR
            Else
                cOptionPrice = 0
            End If
            'Cells(lRow, (lCol + 3)) = cOptionPrice
            stockcols(1, 3) = cOptionPrice
            
            cDiscOption = cOptionPrice * Exp(-(dDiscount) * dTime)
            'Cells(lRow, (lCol + 4)) = cDiscOption
            stockcols(1, 4) = cDiscOption
            
            cPF = dPerfFee * cDiscOption
            cPrevPF = Cells(lRow, (lCol - 2))
            If lCol = 9 Then
                cTotalPF = cPF
            Else:
                cTotalPF = cPF + cTotalPF
            End If
            'Cells(lRow, (lCol + 5)) = cPF
            stockcols(1, 5) = cPF
            
            If lCol = 1766 Then
                cStockAdj = cStock - cTotalPF
            Else:
                cStockAdj = cStock
            End If
            'Cells(lRow, (lCol + 6)) = cStockAdj
            stockcols(1, 6) = cStockAdj


        'Next lCol
        Cells(lRow, lCol).Resize(, UBound(stockcols, 2)) = Application.Transpose(stockcols)
        lCol = lCol + 7
        stockcols = Empty
        If lCol < 1772 Then GoTo NextSet
        
     cFinalStock = Cells(lRow, 1772)
     cAMC = cFinalStock * dAMC
     Cells(lRow, 1773) = cAMC
     cFinalFund = cFinalStock - cAMC
     Cells(lRow, 1774) = cFinalFund
 Next lRow


 Call OptimizeCode_End


 End Sub

 

[mrbojangles92]

Thank you so much for taking the time to give it a go!
Yeah I was looking at arrays but couldn't figure out how to go about it, I've run your code but it doesn't seem to quite work, every column results in the same value for 7 columns and then changes, after 3 Sets it is 0 throughout.
There wasn't a gap between columns but really it is now a bit of a redundant column as it was initially incase the fee was subtracted daily but I have changed that part so now the 7th column and 1st one should be the same until the very end.
Column 2-8 are the initial stock, HWM, 0,0,0,0, initial stock again, and then the idea was read across the row. 9- 15 is the first day so shows a change in initial stock but the HWM should be the same as previous as it is looking back at what the highest value used to be, fee is calculated etc and then there is a column with the stock value again (which is now unnecessary so leaving it blank is also fine).

With that in mind the code

cPrevStock = Cells(lRow, (lCol -1)

Should now be

cPrevStock= Cells(lRow,(lCol-7)

which I have tried but again comes out with the same problems, I am not sure what the values are but assume all of the same values in the columns are the stock price but am going to play further and see if I can figure it out. But I agree something like that that can hold most of the values and calculate from there is better it's just getting how!

Cheers again

 

[igold]

Ok, so there needs to be a little bit of an adjustment on where the code is placing values. That can be done. The real question is, if in fact the code now is doing somewhat near what it is supposed to do... Is it running any faster?

 

[mrbojangles92]

Just run it fully and it comes out at 13 minutes so 7 minutes faster which is great! Especially as I want to run a further 4 years following on from the final stock price of this so every little helps! So it runs through it faster just need to figure out why it is spitting out odd values.

Thanks!

 

[igold]

Great. I also think there are further gains to be had if we expand the size of the array or create additional arrays. Let me look more closely at your Post #5 and see if I can get a better grasp of the data.

 

[mrbojangles92]

Just to throw a spanner in the works, was just running it over a number of years, so have copied my code into multiple macros and made a run button that calls them. When running it on 10 simulations it runs fine. But when running for 10,000 it came up with error 1004 that seems to be attributed to the Application.WorksheetFunction.NormSInv(rnd)....just triying to figure out if a OnError statement would work or make a function to generate the NormSInv(rnd) and if rnd = 0 or 1 to re run it ?

Bleugh!

 

[igold]

I think I found one of my errors. I also tried make it more efficient. This code on my machine with Simulations (Cell B8) = 10000, populated my sheet from cell I12 to cell BPF10111 in less than 1.5 minutes.

Does the accuracy of the output look any better? I think it probably needs some more tweaking...

Sub Dailystockchange()


    Dim cPrevStock As Currency, cPrevHWM As Currency, cStock As Currency, cOptionPrice As Currency
    Dim dRiskFree As Double, dVolatility As Double, dTime As Double, dDiscount As Double, dPerfFee As Double
    Dim lSimulations As Long, lSimulationNumber As Long, lRow As Long, x As Long
    Dim cDiscOption As Currency, cHWM As Currency, cHurdle As Currency
    Dim lCol As Integer
    Dim dAMC As Double, dGrowth As Double, dFTSE As Double, dFTSE1 As Double
    Dim sBenchset As String
    Dim cMaxHWMHR As Currency, cPF As Currency, cPrevPF As Currency, cTotalPF As Currency
    Dim cStockAdj As Currency, cFinalStock As Currency, cAMC As Currency, cFinalFund As Currency
    Dim ctr As Long, rct As Long
    Dim stockcols(0 To 1800) As Variant
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    dRiskFree = Cells(4, 2)
    dVolatility = Cells(5, 2)
    dTime = Cells(6, 2)
    lSimulations = Cells(8, 2)
    dDiscount = Cells(3, 5)
    sBenchset = Cells(8, 5)
    dGrowth = Cells(3, 9)
    dPerfFee = Cells(4, 5)
    dAMC = Cells(5, 5)
    'Call OptimizeCode_Begin
    x = lSimulations + 11
    For lRow = 12 To x
        'For lCol = 9 To 1772 Step 7
        lCol = 9
        ctr = 0
        
NextSet:
            'stockcols = Range(Cells(lRow, lCol), Cells(lRow, lCol + 6))
            
            cPrevStock = Cells(lRow, (lCol - 1))
            cPrevHWM = Cells(lRow, (lCol - 6))
            cStock = cPrevStock * Exp((dRiskFree - ((dVolatility ^ 2) * 0.5)) * dTime + dVolatility * Application.WorksheetFunction.NormSInv(Rnd) * (dTime ^ 0.5))
            'Cells(lRow, (lCol)) = cStock
            stockcols(0 + ctr) = cStock
            
            If cPrevStock > cPrevHWM Then
                cHWM = cPrevStock
            Else
                cHWM = cPrevHWM
            End If
            'Cells(lRow, (lCol + 1)) = cHWM
            stockcols(1 + ctr) = cHWM
            
            If sBenchset = "Follow stock" Then
                cHurdle = 0
            ElseIf sBenchset = "Constant Growth" Then
                cHurdle = cPrevHWM * (1 + dGrowth)
            ElseIf sBenchset = "Follow index" Then
                dFTSE1 = Cells(9, lCol)
                cHurdle = cPrevHWM * (1 + dFTSE1)
            End If
            'Cells(lRow, (lCol + 2)) = cHurdle
            stockcols(2 + ctr) = cHurdle


            If cHWM > cHurdle Then
                cMaxHWMHR = cHWM
            Else:
                cMaxHWMHR = cHurdle
            End If
         
            If cStock > cMaxHWMHR Then
                cOptionPrice = cStock - cMaxHWMHR
            Else
                cOptionPrice = 0
            End If
            'Cells(lRow, (lCol + 3)) = cOptionPrice
            stockcols(3 + ctr) = cOptionPrice
            
            cDiscOption = cOptionPrice * Exp(-(dDiscount) * dTime)
            'Cells(lRow, (lCol + 4)) = cDiscOption
            stockcols(4 + ctr) = cDiscOption
            
            cPF = dPerfFee * cDiscOption
            cPrevPF = Cells(lRow, (lCol - 2))
            If lCol = 9 Then
                cTotalPF = cPF
            Else:
                cTotalPF = cPF + cTotalPF
            End If
            'Cells(lRow, (lCol + 5)) = cPF
            stockcols(5 + ctr) = cPF
            
            If lCol = 1766 Then
                cStockAdj = cStock - cTotalPF
            Else:
                cStockAdj = cStock
            End If
            'Cells(lRow, (lCol + 6)) = cStockAdj
            stockcols(6 + ctr) = cStockAdj


        'Next lCol
        
        lCol = lCol + 7
        ctr = ctr + 7
        'stockcols
        
        If lCol < 1772 Then GoTo NextSet
        If lCol > 1772 Then
            Cells(lRow, 9).Resize(, UBound(stockcols) + 1) = stockcols
            ctr = 0
        End If
     cFinalStock = Cells(lRow, 1772)
     cAMC = cFinalStock * dAMC
     Cells(lRow, 1773) = cAMC
     cFinalFund = cFinalStock - cAMC
     Cells(lRow, 1774) = cFinalFund
 Next lRow


 'Call OptimizeCode_End
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Done"
 End Sub

Let me know how it goes.