Faster Way to Loop Through Cells?

A

AlexR688

New Member
Joined
Aug 26, 2013
Messages
10
Hi everyone,

I'm quite new to VBA and need to produce a Monte Carlo simulation and then save the results.

Currently, I have several macros that look through cells in loops, do calculations and then print the value to new cells. This is quite time consuming and was wondering if there's a way to make this faster?

Below my macro essentially takes current stock price from a cell (generated by another Sub) and then returns an expected stock price and Heston call price by simulating another number of paths, with time to the end decreasing as it goes along. Is there perhaps a faster way to do this with arrays?

Thanks in advance!

Code: 
Global Const RndHigh = 0.999999999999999
Global Const RndLow = 0.000000000000001

Sub GenExpStockPrices()


Application.ScreenUpdating = False


Dim time As Single


Paths = Sheets("FM408 Q1").Cells(2, 3).Value
Steps = Sheets("FM408 Q1").Cells(3, 3).Value
lambda = Sheets("FM408 Q1").Cells(4, 3).Value
rho = Sheets("FM408 Q1").Cells(5, 3).Value
eta = Sheets("FM408 Q1").Cells(6, 3).Value
Vbar = Sheets("FM408 Q1").Cells(7, 3).Value
v0 = Sheets("FM408 Q1").Cells(8, 3).Value
s0 = Sheets("FM408 Q1").Cells(9, 3).Value
K = Sheets("FM408 Q1").Cells(10, 3).Value
r = Sheets("FM408 Q1").Cells(11, 3).Value
T = Sheets("FM408 Q1").Cells(12, 3).Value


For OldPath = 1 To Paths


StSum = 0
HCallSum = 0


    For NewTime = 1 To Steps
    
    StSum = 0
    HCallSum = 0
    NewSteps = Steps - NewTime
    
    If NewSteps = 0 Then
        GoTo Maturity
    
    Else
        GoTo NotMaturity
    
NotMaturity:
    
        Deltat = T / NewSteps
            
        '    For time = 1 To NewSteps
                    
                For Path = 1 To Paths
                
                    St = Sheets("FM408 Q1").Cells((-8 + (10 * Path)), NewTime + 10).Value
                    xt = Log(St)
                    Vt = Sheets("FM408 Q1").Cells((-7 + (10 * Path)), NewTime + 10).Value
                    
                        For Subtime = 1 To NewSteps
                                               
                        Randomize
                        RndA = Rnd()
                        If RndA <= 0 Then
                        RndA = RndLow
                        ElseIf RndA >= 1 Then
                        RndA = RndHigh
                        End If
                        RndB = Rnd()
                        If RndB <= 0 Then
                        RndB = RndLow
                        ElseIf RndB >= 1 Then
                        RndB = RndHigh
                        End If
                        A = Application.Norm_S_Inv(RndA)
                        B = Application.Norm_S_Inv(RndB)
                        C = (rho * A) + (Sqr(1 - ((rho) ^ 2)) * B)
                        
                        xt = xt + ((r - (Vt / 2)) * Deltat) + (Sqr(Vt * Deltat) * A)
                        Vt = Vt - lambda * ((Vt - Vbar) * Deltat) + (eta * Sqr(Vt) * Sqr(Deltat) * C) + (((eta ^ 2) / 4) * Deltat * ((C ^ 2) - 1))
                        Vt = Abs(Vt)
                        St = Exp(xt)
                        HCall = Application.Max(0, (St - K))
                        
                        Next Subtime
                
                    StSum = StSum + St
                    HCallSum = HCallSum + HCall
                        
                Next Path
                
                    ExpSt = StSum / Paths
                    Sheets("FM408 Q1").Cells(((10 * OldPath) - 5), (10 + NewTime)).Value = ExpSt
                    ExpHCall = HCallSum / Paths
                    Sheets("FM408 Q1").Cells(((10 * OldPath) - 4), (10 + NewTime)).Value = ExpHCall
                    
    End If
    Next NewTime
    
    
Maturity:
    
    Sheets("FM408 Q1").Cells((-4 + (10 * OldPath)), Steps + 10).Value = Application.Max(Sheets("FM408 Q1").Cells((-8 + (10 * OldPath)), Steps + 10).Value - K, 0)
    Sheets("FM408 Q1").Cells(((10 * OldPath) - 5), Steps + 10).Value = Sheets("FM408 Q1").Cells((-8 + (10 * OldPath)), Steps + 10).Value


Next OldPath


Call GenExpStockPrices0


End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
Rick,

I hadn't seen you had posted again in the last thread - apologies.

That makes sense and I have corrected the code as required.

I suppose my question now is whether the code above can be adapted in a way that does not require input/output interaction with the worksheet, and if so, will this make it run much faster?

Thanks
 
Upvote 0
AlexR688 said:
Rick,

I hadn't seen you had posted again in the last thread - apologies.

That makes sense and I have corrected the code as required.

I suppose my question now is whether the code above can be adapted in a way that does not require input/output interaction with the worksheet, and if so, will this make it run much faster?
Click to expand...
Since you have "corrected" the code in accordance with what I posted in that other thread, why don't you post the code you now have so we can respond for it instead of what you posted in Message #1.
 
Upvote 0
A little more background:

The variables at the beginning will need to be changed from time to time, hence why I have them as inputs on the worksheets. Similarly, Randomize is called in an earlier Sub, and so I have taken it out of this one as suggested previously.

The Sub GenExpStockPrices0 afterwards is the same as the one posted below, except that it deals with a special case right at the beginning of the stock price series.

Hope this makes things clearer.

Thanks!

Code: 
Global Const RndLow = Global Const RndLow = 0.0000001

Sub GenExpStockPrices()

Application.ScreenUpdating = False


Dim time As Single


Paths = Sheets("Q1").Cells(2, 3).Value
Steps = Sheets("Q1").Cells(3, 3).Value
lambda = Sheets("Q1").Cells(4, 3).Value
rho = Sheets("Q1").Cells(5, 3).Value
eta = Sheets("Q1").Cells(6, 3).Value
Vbar = Sheets("Q1").Cells(7, 3).Value
v0 = Sheets("Q1").Cells(8, 3).Value
s0 = Sheets("Q1").Cells(9, 3).Value
K = Sheets("Q1").Cells(10, 3).Value
r = Sheets("Q1").Cells(11, 3).Value
T = Sheets("Q1").Cells(12, 3).Value


For OldPath = 1 To Paths


StSum = 0
HCallSum = 0


    For NewTime = 1 To Steps
    
    StSum = 0
    HCallSum = 0
    NewSteps = Steps - NewTime
    
    If NewSteps = 0 Then
        GoTo Maturity
    
    Else
        GoTo NotMaturity
    
NotMaturity:
    
        Deltat = T / NewSteps
            
        '    For time = 1 To NewSteps
                    
                For Path = 1 To Paths
                
                    St = Sheets("Q1").Cells((-8 + (10 * Path)), NewTime + 10).Value
                    xt = Log(St)
                    Vt = Sheets("Q1").Cells((-7 + (10 * Path)), NewTime + 10).Value
                    
                        For Subtime = 1 To NewSteps
                                               
                        RndA = Rnd()
                        If RndA <= 0 Then
                        RndA = RndLow
                        End If
                        RndB = Rnd()
                        If RndB <= 0 Then
                        RndB = RndLow
                        End If
                        A = Application.Norm_S_Inv(RndA)
                        B = Application.Norm_S_Inv(RndB)
                        C = (rho * A) + (Sqr(1 - ((rho) ^ 2)) * B)
                        
                        xt = xt + ((r - (Vt / 2)) * Deltat) + (Sqr(Vt * Deltat) * A)
                        Vt = Vt - lambda * ((Vt - Vbar) * Deltat) + (eta * Sqr(Vt) * Sqr(Deltat) * C) + (((eta ^ 2) / 4) * Deltat * ((C ^ 2) - 1))
                        Vt = Abs(Vt)
                        St = Exp(xt)
                        HCall = Application.Max(0, (St - K))
                        
                        Next Subtime
                
                    StSum = StSum + St
                    HCallSum = HCallSum + HCall
                        
                Next Path
                
                    ExpSt = StSum / Paths
                    Sheets("Q1").Cells(((10 * OldPath) - 5), (10 + NewTime)).Value = ExpSt
                    ExpHCall = HCallSum / Paths
                    Sheets("Q1").Cells(((10 * OldPath) - 4), (10 + NewTime)).Value = ExpHCall
                    
    End If
    Next NewTime
    
    
Maturity:
    
    Sheets("Q1").Cells((-4 + (10 * OldPath)), Steps + 10).Value = Application.Max(Sheets("Q1").Cells((-8 + (10 * OldPath)), Steps + 10).Value - K, 0)
    Sheets("Q1").Cells(((10 * OldPath) - 5), Steps + 10).Value = Sheets("Q1").Cells((-8 + (10 * OldPath)), Steps + 10).Value


Next OldPath


Call GenExpStockPrices0


End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
VBA: Loop thru array of cells
Replies
2
Views
830
FryGirl
F
A
  • Question Question
First VBA Project - is there a better way to write this code?
Replies
0
Views
2K
akshay27
A
C
  • Question Question
Complex VBA code - Multiple IF conditions including Worksheet Name contains text partially matching Cell
Replies
1
Views
3K
celebwen_orn
C
Johnny Thunder
  • Question Question
VBA Help - Combine 2 Macros in One - Excel 2016
Replies
6
Views
1K
Eric W
Eric W
J
  • Question Question
Excel crashes when playing code, but is fine when stepped through
Replies
4
Views
1K
JWatson220
J

Forum statistics

Threads
1,223,227
Messages
6,170,853
Members
452,361
Latest member
d3ad3y3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top