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!

 

[mrbojangles92]

So a definite step in the right direction. It populated all the required data for the first set but doesn't fill in the further sets. Which I can't figure out, when I step through the code the lCol does increase by 7 as expected so I am not sure why it seems to run all the rows but not across because the code seems to be that the full year simulation is done and then move to the next row ie a new simulation? I'm having a little play about let me know if you have any ideas. And thanks again really appreciate it!

Oh also, if you then run the macro again it completes the next set.

 

[mrbojangles92]

Ok I think I know where the issue is; the first set works because it used the initial stock which is inputted by me using

PrevStock = Cells(lRow, lCol - 6)

Buuut to move to the next day the Prev stock used is the original one because when reading the worksheet it hasn't updated possibly?
i.e I had data for initial stock of 100 already in the sheet, when I ran your code with S0 = 1000, S1 in the immediate window is 1003.43 but S2 is 101.47
Not sure how it is possible to get around other than change PrevStock statement
or
change cStock = cStock *.... to do a circular calculation and make and If statement to read the initial stock at lCol =2 ?

 

[igold]

Just to be clear... you let it run until the message box "Done" came up and it only populated 1 row of data?

 

[mrbojangles92]

Yeah a run until MsgBox appears, but it DOES appear to run all the way through but the output is wrong other then the first set because it is reading the line cPrevStock etc and picking up the 'old' value if that makes any sense. i.e if before I start 50.23 is the value of S2 and then I start trying to simulate stock of 1000 S3 will be calculated by using the 50.23 value.
But I have added a couple of If statements:

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
    
    
    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))
            
            [B]If lCol = 9 Then
                cPrevStock = Cells(lRow, (lCol - 1))
            Else:
                cPrevStock = cStockAdj
            End If[/B]
            
            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
            
            [B]If lCol = 9 Then
                cPrevHWM = Cells(lRow, lCol - 6)
            Else
                cPrevHWM = cHWM
            End If[/B]
            
            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
        Cells(7, 6) = lCol
        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
    MsgBox "Done"
 End Sub

Which seems to have worked when I did a quick run with 10 simulations, just gunna do the full whack now fingers crossed!