Speed up slow calculation in vba

michael123 · Nov 9th 2010

This is my first code ive written in vba so I apologise in advance...

My problem is this...
I have created a macro that calculates mduration, it take the relevent inputs and plugs it into the macro version of mduration (a function). The macro runs fine all the way through. However, it takes about 13mins to complete!!!

I have tried everything that I could think of but alas my knowledge of vba is not good enough.

My question is:
Can anyone help me find a way to reduce this speed, in an ideal world to under a minute.

IMPORTANT THINGS TO BE AWARE OF:
- The this macro runs on 130,000 rows!
- The only way i could think to create this macro is with a loop (suggestions welcome)

I have used alot of "offset" in my coding so the actual columns are the following;

AD = where i want the results to appear
AK = coupon
K = NAV
E = Nominal
AB = Mdate
Q = asset type
AC = maturity

Once again this is my first code and first post so its not perfect.

Thank you!!!!

Code

Sub mduration()
 
 
 
Dim mduration As Variant
Dim yield As Single
Dim coupon As Single
Dim nav As Single
Dim nominal As Single
Dim mdate As Date
Dim mdateround As Date
Dim asset As String
Dim maturity As Double
Dim mdurationround As Variant
 
 
 
'to speed up sheet calculation: mdowsett 04/11/2010
Application.DisplayAlerts = False
Application.Calculation = xlCalculateManual
Application.ScreenUpdating = False
 
 
 
'change to correct column (Mduration) and first row: mdowsett 04/11/2010
Range("ad3").Select
 
 
 
    Do
           
      
     
     
                'Only bonds etc remaing: mdowsett 05/11/2010
            If ActiveCell.Offset(0, -13).Value <> "Bond" And ActiveCell.Offset(0, -13).Value <> "Non-concerned Bond" And ActiveCell.Offset(0, -13).Value <> "Non-EEA gvt" And ActiveCell.Offset(0, -13).Value <> "Non-concerned bond" Then
     
     
                      ActiveCell.Value = ""
           
               
                'if nav has no value
               
              
               
            ElseIf ActiveCell.Offset(0, -19).Value = 0 Then ActiveCell.Value = "not applicable"
               
                'if term to maturity has no value
            ElseIf ActiveCell.Offset(0, -1).Value = 0 Then ActiveCell.Value = 0
           
           
           
                'if maturity date has no value: 05/11/2010
            ElseIf ActiveCell.Offset(0, -2).Value = "" Then
   
         
       
                    'calculation for parts of mduration: mdowsett 04/11/2010
       
                    maturity = ActiveCell.Offset(0, -1).Value
                    mdateround = Round((40178 + (maturity * 365)), 0)
                    nominal = ActiveCell.Offset(0, -25).Value
                    nav = ActiveCell.Offset(0, -19).Value
                    coupon = (ActiveCell.Offset(0, 7).Value / 100)
                   
       
                     yield = coupon / (nav / nominal)
 
                    'muduration with a missing maturity date: 05/11/2010
                    mdurationround = Application.WorksheetFunction.mduration("12/31/2009", mdateround, coupon, yield, 1, 1)
           
                    ActiveCell.Value = mdurationround
       
       
            ElseIf ActiveCell.Offset(0, -2).Value <> "" Then
 
                    maturity = ActiveCell.Offset(0, -1).Value
                    mdate = ActiveCell.Offset(0, -2).Value
                    nominal = ActiveCell.Offset(0, -25).Value
                    nav = ActiveCell.Offset(0, -19).Value
                    coupon = (ActiveCell.Offset(0, 7).Value / 100)
                 
 
                     yield = coupon / (nav / nominal)
 
                    'mduration with maturity date: 05/11/2010
                    mduration = Application.WorksheetFunction.mduration("12/31/2009", mdate, coupon, yield, 1, 1)
                    ActiveCell.Value = mduration
       
 
            End If
 
                ActiveCell.Offset(1, 0).Select
 
     'until asset type has no value: 05/11/2010
    Loop Until ActiveCell.Offset(0, -13).Value = 0
 
 
'turn calculations back on: mdowsett 04/11/2010
 
Application.Calculation = xlCalculateAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
msgbox "Completed", 0, "MDuration"
 
End Sub

Display More

michael123 · Nov 9th 2010

Re: Speed up mduraiton calculation in vba

Sorry i posted a messy code.............here is a neater version with very slight (but irrevent) bits taken out.................

Code

Sub mduration()
 
Dim mduration As Variant
Dim yield As Single
Dim coupon As Single
Dim nav As Single
Dim nominal As Single
Dim mdate As Date
Dim mdateround As Date
Dim asset As String
Dim maturity As Double
Dim mdurationround As Variant
 
'to speed up sheet calculation: mdowsett 04/11/2010
Application.DisplayAlerts = False
Application.Calculation = xlCalculateManual
Application.ScreenUpdating = False
 
'change to correct column (Mduration) and first row: mdowsett 04/11/2010
Range("ad3").Select
 
 
    Do
 
 
                'Only bonds etc remaing.
                'NOTE capital B and non capital b on "Non-concerned Bonds" both need to be accounted for: mdowsett 05/11/2010
 
            If ActiveCell.Offset(0, -13).Value <> "Bond" And ActiveCell.Offset(0, -13).Value <> "Non-concerned Bond" And ActiveCell.Offset(0, -13).Value <> "Non-EEA gvt" And ActiveCell.Offset(0, -13).Value <> "Non-concerned bond" Then
 
 
                      ActiveCell.Value = ""
 
 
                'if nav has no value: mdowsett 09/11/2010
            ElseIf ActiveCell.Offset(0, -19).Value = 0 Then ActiveCell.Value = "not applicable"
 
 
                'if term to maturity has no value: mdowsett 09/11/2010
            ElseIf ActiveCell.Offset(0, -1).Value = 0 Then ActiveCell.Value = 0
 
 
 
                'if maturity date has no value: mdowsett 05/11/2010
            ElseIf ActiveCell.Offset(0, -2).Value = "" Then
 
 
 
                    'calculation for parts of mduration: mdowsett 04/11/2010
 
                    maturity = ActiveCell.Offset(0, -1).Value
                    mdateround = Round((40178 + (maturity * 365)), 0)
                    nominal = ActiveCell.Offset(0, -25).Value
                    nav = ActiveCell.Offset(0, -19).Value
                    coupon = (ActiveCell.Offset(0, 7).Value / 100)
 
 
                     yield = coupon / (nav / nominal)
                    'muduration with a missing maturity date: 05/11/2010
                    mdurationround = Application.WorksheetFunction.mduration("12/31/2009", mdateround, coupon, yield, 1, 1)
 
                    ActiveCell.Value = mdurationround
 
 
            ElseIf ActiveCell.Offset(0, -2).Value <> "" Then
 
                    maturity = ActiveCell.Offset(0, -1).Value
                    mdate = ActiveCell.Offset(0, -2).Value
                    nominal = ActiveCell.Offset(0, -25).Value
                    nav = ActiveCell.Offset(0, -19).Value
                    coupon = (ActiveCell.Offset(0, 7).Value / 100)
 
                     yield = coupon / (nav / nominal)
                    'mduration with maturity date: 05/11/2010
                    mduration = Application.WorksheetFunction.mduration("12/31/2009", mdate, coupon, yield, 1, 1)
                    ActiveCell.Value = mduration
 
            End If
                ActiveCell.Offset(1, 0).Select
     'until asset type has no value: 05/11/2010
    Loop Until ActiveCell.Offset(0, -13).Value = 0
 
 
 
'turn calculations back on: mdowsett 04/11/2010
 
 
Application.Calculation = xlCalculateAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
msgbox "Completed", 0, "MDuration"
 
End Sub

Display More

**cytop** · Nov 9th 2010

Re: Speed up slow calculation in vba

Ughhhh - wouldn't know where to start!

If the worksheet contains 130,000 then you do have some work to do.

All those Element.property.property.value identifiers take time for VBA to workthrough. It might be a start to:

If you know where each column is, code them specifically rather than relying on Offset. You could set then as a variable in case they change (But I seriously doubt they will!)

That first If... statement could be rationalised. Perhaps get the value of the cell in offset(0, -13) and then compare the value in the variable.

You assign values to variables which are only used once.
As ease of reading is probably not an issue here, why assign to a variable and then use that variable only once in a call to a function?
For example, replace

Code

maturity = ActiveCell.Offset(0, -1).Value
mdateround = Round((40178 + (maturity * 365)), 0)

with

Code

mdateround = Round((40178 + (ActiveCell.Offset(0, -1).Value* 365)), 0)

Where possible use With...End With

Only my thoughts - without a copy of the workbook it's hard to comment, but I doubt you'd manage to post a resonably sized example even if you could remove all confidential data.

AAE · Nov 9th 2010

Re: Speed up slow calculation in vba

Well, you've discovered the pitfall of looping - it is inefficient because you are working on a cell-by-cell basis. You've already included a few tricks to speed up the code by turning off calculation and screen updating, etc.

If possible, re-develop your approach to use filtering and the SpecialCells(xlCellTypeVisible) property to act upon a entire range of cells in one go.
Just looking at the code, it seems you could/should be using formula directly in the cells, which is typically much faster than using code.

michael123 · Nov 9th 2010

Re: Speed up slow calculation in vba

Thank you both for your quick replies and help!

cytop:
I have changed the coding as you've said and am now looking into With, End With...so thank you!!

AAE:
It has to run using code. Im looking into special cells and filtering. So thank you aswell!!

If I manage to reduce the time i will update the post so you can (hopefully) approve.

Once again thank you both for putting the time in to help!

**cytop** · Nov 9th 2010

Re: Speed up slow calculation in vba

We don't 'approve' or 'disapprove'. If you post your results it just helps us as well.

AAE · Nov 9th 2010

Re: Speed up slow calculation in vba

Quote

It has to run using code. Im looking into special cells and filtering.

I meant: use VBA to automate filtering and using the SpecialCells(xlCellTypeVisible) property to act on the visible cells.

Rob Xaos · Nov 10th 2010

Re: Speed up slow calculation in vba

Just to chip in here with some further ideas about optimisation.

There are times when

Quote

It has to run using code

but in my experience, people often reach for VBA too soon. VBA is excellent when used correctly and does solve problems that cannot be done even by the most complex of formulas. However if used incorrectly it can bring with it huge performance issues.

I would look again at your calculations and see if there is a way to perform some of the terms of the calculation as formulae. The less that has to be done by VBA the better. These partial terms can be hidden either in hidden columns, rows or even on a separate 'pre-calculation' sheet. Try to take an approach that minimises the amount of processing the VBA is required to do.

A brief skim of the code to me shows no clear reason why it has to be in VBA. You perform a number of calculations which are used as parameters for the financial function MDURATION the result of which is assigned to the ActiveCell. On the surface this looks like it could all be done as a formula.

As a side note I would avoid having your own procedure with the same name as the built-in financial formula and I would avoid having a variable within that procedure also with the same name. Although this compiles and runs it makes it difficult to read.

michael123 · Nov 10th 2010

Re: Speed up slow calculation in vba

Hi Rob,

Basically I wanted to find a way to calculate mduration quickly for over 130,000 cells, although it takes a long time (at the moment). It has to run off a button so that other users (who are not familular with the mduration calculation) can easily calculate it, or be it have a long coffee break while it is.

Im looking into autofiltering so that it can run faster and applying the suggestions from "AAE", but for me it's a slow process as i'm very new to vba.

Thank you for taking the time to help (I have changed the names as suggested, many thanks)

michael123 · Nov 10th 2010

Re: Speed up slow calculation in vba

UPDATED CODE

Code

Sub calculate_modified_duration()
 
Dim modified_duration As Variant
Dim yield As Single
Dim coupon As Single
Dim nav As Single
Dim nominal As Single
Dim mdate As Date
Dim mdateround As Date
Dim asset As String
Dim maturity As Double
Dim modified_duration_round As Variant
Dim t
t = Timer
 
'to speed up sheet calculation: mdowsett 04/11/2010
Application.DisplayAlerts = False
Application.Calculation = xlCalculateManual
Application.ScreenUpdating = False
 
'change to correct column (Mduration) and first row: mdowsett 04/11/2010
Range("ad3").Select
 
    Do
 
 
                'Only bonds etc remaing.
                'NOTE capital B and non capital b on "Non-concerned Bonds" both need to be accounted for: mdowsett 05/11/2010
 
            If ActiveCell.Offset(0, -13).Value <> "Bond" And ActiveCell.Offset(0, -13).Value <> "Non-concerned Bond" And ActiveCell.Offset(0, -13).Value <> "Non-EEA gvt" And ActiveCell.Offset(0, -13).Value <> "Non-concerned bond" Then
 
 
                      ActiveCell.Value = ""
 
 
                'if nav has no value: mdowsett 09/11/2010
            ElseIf ActiveCell.Offset(0, -19).Value = 0 Then ActiveCell.Value = "not applicable"
 
 
                'if term to maturity has no value: mdowsett 09/11/2010
            ElseIf ActiveCell.Offset(0, -1).Value = 0 Then ActiveCell.Value = 0
 
 
 
                'if maturity date has no value: mdowsett 05/11/2010
            ElseIf ActiveCell.Offset(0, -2).Value = "" Then
 
 
 
                    'calculation for parts of mduration: mdowsett 04/11/2010
 
                    mdateround = Round((40178 + (ActiveCell.Offset(0, -1).Value * 365)), 0)
                    nominal = ActiveCell.Offset(0, -25).Value
                    nav = ActiveCell.Offset(0, -19).Value
                    coupon = (ActiveCell.Offset(0, 7).Value / 100)
 
 
                     yield = coupon / (nav / nominal)
 
                    'muduration with a missing maturity date: 05/11/2010
                    modified_duration_round = Application.WorksheetFunction.mduration("12/31/2009", mdateround, coupon, yield, 1, 1)
 
                    ActiveCell.Value = modified_duration_round
 
 
            ElseIf ActiveCell.Offset(0, -2).Value <> "" Then
 
                    maturity = ActiveCell.Offset(0, -1).Value
                    mdate = ActiveCell.Offset(0, -2).Value
                    nominal = ActiveCell.Offset(0, -25).Value
                    nav = ActiveCell.Offset(0, -19).Value
                    coupon = (ActiveCell.Offset(0, 7).Value / 100)
 
                     yield = coupon / (nav / nominal)
 
                    'mduration with maturity date: 05/11/2010
                    modified_duration = Application.WorksheetFunction.mduration("12/31/2009", mdate, coupon, yield, 1, 1)
                    ActiveCell.Value = modified_duration
 
            End If
                ActiveCell.Offset(1, 0).Select
                'until asset type has no value: 05/11/2010
    Loop Until ActiveCell.Offset(0, -13).Value = 0
 
'turn calculations back on: mdowsett 04/11/2010
 
Application.Calculation = xlCalculateAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
 
msgbox "MDuration Complete. Elapsed time " & Format((Round(Timer - t, 2) / 60), "00.00") & "mins"
 
End Sub

Display More

michael123 · Nov 12th 2010

FYI

After much debating and taking into account the helpful responses. I have re-designed my code to the following:

Code

Sub mduration_paste_special()
'
' test Macro
Dim LastRow As Long
Dim t
 
'user message box
msgbox "Caution: Screen may appear to freeze." & vbCrLf & vbCrLf & "Please do not close excel.", vbInformation, "Please Wait..."
 
t = Timer
Application.DisplayAlerts = False
Application.Calculation = xlCalculateManual
Application.ScreenUpdating = False
 
    Range("AD3").Select
 
'apply formula
    ActiveCell.FormulaR1C1 = _
        "=IF(OR(RC17=""Bond"",RC17=""Non-concerned bond"",RC17=""Non-EEA gvt"")=TRUE,IF(or((rc11=0),(RC29=0)),0,IF(RC28="""",MDURATION(DATEVALUE(""31/12/2009""),ROUNDUP((DATEVALUE(""31/12/2009"")+(RC29*365)),0),RC36%,RC36%/(RC11/RC5),1),MDURATION(DATEVALUE(""31/12/2009""),RC28,RC36%,(RC36%/(RC11/RC5)),1))),""not applicable"")"
 
'autofill to last row
LastRow = Cells(Rows.Count, "q").End(xlUp).Row
    Range("AD3").AutoFill Destination:=Range("AD3:AD" & LastRow)
 
'copy and paste special
ActiveSheet.Calculate
Range("AD3:AD" & LastRow).Copy
 ActiveSheet.Range("AD3").PasteSpecial xlPasteValues
 
 
Application.DisplayAlerts = True
Application.Calculation = xlCalculateautomatic
Application.ScreenUpdating = True
 
'display elapsed time
msgbox "MDuration Complete." & vbCrLf & vbCrLf & "Elapsed time: " & Format((Round(Timer - t, 2)), " 00") & "seconds", vbInformation
 
 
End Sub

Display More

As most can see it pastes the formula into the first cell in the column.

Autofills that formula to the last row.

Copys the cells and then paste special the values back.

displays a "elapsed time" box

COMPLETION TIME: 20sec approx (for over 130,000 rows)

Once again many thanks for all your posts, they have been a great help to me!

**cytop** · Nov 12th 2010

Re: Speed up slow calculation in vba

And thanks for posting your results, it's always nice to see a good outcome. A speed up by a factor of 60x is no mean achievement... so well done :congrats:

Wigi · Nov 12th 2010

Re: Speed up slow calculation in vba

Untested, but perhaps this is faster:

Code

Sub mduration_paste_special()
'
' test Macro
    
    'user message box
    MsgBox "Caution: Screen may appear to freeze." & vbCrLf & vbCrLf & "Please do not close Excel.", vbInformation, "Please Wait..."


    t = Timer
    Application.Calculation = xlCalculateManual
    Application.ScreenUpdating = False


    With Range("AD3:AD" & Cells(Rows.Count, "Q").End(xlUp).Row)
        .FormulaR1C1 = _
            "=IF(OR(RC17=""Bond"",RC17=""Non-concerned bond"",RC17=""Non-EEA gvt""),IF(or(rc11=0,RC29=0),0,IF(RC28="""",MDURATION(DATEVALUE(""31/12/2009""),ROUNDUP((DATEVALUE(""31/12/2009"")+(RC29*365)),0),RC36%,RC36%/(RC11/RC5),1),MDURATION(DATEVALUE(""31/12/2009""),RC28,RC36%,RC36%/(RC11/RC5),1))),""not applicable"")"
        ActiveSheet.Calculate
        .Value = .Value
    End With
    
    Application.Calculation = xlCalculateautomatic


    'display elapsed time
    MsgBox "MDuration Complete." & vbCrLf & vbCrLf & "Elapsed time: " & Format(Round(Timer - t, 2), "00") & " seconds", vbInformation


End Sub

Display More

In any case, it's easier (according to me).

Wigi

Speed up slow calculation in vba

Participate now!

Share

Users Viewing This Thread