Help to speeding up VBA code

cjms85

New Member
Joined
Jul 7, 2009
Messages
19
Hi all,

I've recently inherited a Financial Forecasting Model which was created rather a long time ago. The model was using lots of pre-2007 Excel formulas, which I've tried to get rid of.

https://drive.google.com/file/d/0B__bxAaMPpZZTEFrMEQ2Njl2eTA/view?usp=sharing

In addition to this, it also has some VBA code, which computes multiple iterations using a Do and Loop functions. This seems to run quite slowly, especially, as the model was originally intended to run up to 2000 iterations. Hence the 2000 rows on the "Iteration Results" Worksheet in the linked workbook.

Below is the code, which I've already cleaned up a little.

I have two questions:
  1. How can I make it run faster/is there a less intensive way to achieve the same result?
  2. I can't figure out why the number of iterated rows is always 3 less than the number of iterations declared?

With respect to the 2nd question, If you specify 10, 20 or 30 iterations etc. the code will produce 7, 17 or 27 rows worth of data. I don't think this can have been intentional?

I've worked out a cludgy fix, which was to change
Code:
Perc = 100 * (Row / (It + 10))
to
Code:
Perc = 100 * (Row / (It + 13))

As you can probably tell, I'm rather new to VBA, so any help would be greatly appreciated.

Code:
Sub cmd_RunStats_Click()
'
' Run Stats Macro
' Clear Data Table
    Range("U14:AS2013").ClearContents
    Range("A1").Select
' Set Variables
    Dim Row As Integer
    Dim Col As Integer
    Dim Perc As Integer
    Dim It As Integer
    Dim TenPerRow As Integer
    Dim FifPerRow As Integer
    Dim NinPerRow As Integer
    Row = 13
    Col = 21
    Perc = 0
 ' Input Number of Iterations from Cell "T5"
    It = Cells(5, 20).Value
 ' Set Row for Percentage Results
    TenPerRow = It * 0.1
    FifPerRow = It * 0.5
    NinPerRow = It * 0.9
 ' Data Collection Loop for number of iterations
    Do While Row < (It + 13)
    'Increment current storage Row and recalculate results
    Row = Row + 1
    Calculate
    'Put iteration data into current storage row
    For myCol = 21 To 45
        Cells(Row, myCol).Value = Cells(7, myCol).Value
    Next myCol
    'Calculate and display the percentage progress in Cell "U5"
    'Perc = 100 * (Row / (It + 10)) ' ORIGINAL CODE
    Perc = 100 * (Row / (It + 13)) 'CLUDGY FIX
    Cells(5, 21).Value = Perc
    Loop
 ' End of Loop
End Sub
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
2,081
Office Version
  1. 365
Platform
  1. Windows
I'm looking at your code. This is the first thing I noticed.

These variables are integer type. You are doing calcs with decimals. Did you intend that.
Code:
Dim It As Integer
    Dim TenPerRow As Integer
    Dim FifPerRow As Integer
    Dim NinPerRow As Integer
 

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
2,081
Office Version
  1. 365
Platform
  1. Windows
Turn these things off while the macro is running
Code:
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
Then turn them back on
Code:
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
 

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
2,081
Office Version
  1. 365
Platform
  1. Windows
I took out the For Loop for applying values across the columns and replaced it with a single statement

Code:
Sub cmd_RunStats_Click()
'
' Run Stats Macro
' Clear Data Table
    Range("U14:AS2013").ClearContents
    'Range("A1").Select
' Set Variables
    Dim Row As Integer
    Dim Col As Integer
    Dim Perc As Integer
    Dim It As Integer
    Dim TenPerRow As Single          'Not used at all
    Dim FifPerRow As Single          'Not used at all
    Dim NinPerRow As Single          'Not used at all
    Dim Col1 As Long
    Dim Col2 As Long
    Col1 = 21
    Col2 = 45
    Row = 13
    Col = 21
    Perc = 0
 ' Input Number of Iterations from Cell "T5"
    It = Cells(5, 20).Value
 ' Set Row for Percentage Results
    TenPerRow = It * 0.1          'Not used at all
    FifPerRow = It * 0.5          'Not used at all
    NinPerRow = It * 0.9          'Not used at all
 ' Data Collection Loop for number of iterations
    Do While Row < (It + 13)
      'Increment current storage Row and recalculate results
      Row = Row + 1
      Calculate
      'No iteration needed
      Range(Cells(Row, Col1), Cells(Row, Col2)).Value = Range(Cells(7, Col1), Cells(7, Col2)).Value




'    For myCol = 21 To 45
'        Cells(Row, myCol).Value = Cells(7, myCol).Value
'    Next myCol
      'Calculate and display the percentage progress in Cell "U5"
      'Perc = 100 * (Row / (It + 10)) ' ORIGINAL CODE
      Perc = 100 * (Row / (It + 13)) 'CLUDGY FIX
      Cells(5, 21).Value = Perc
    Loop
 ' End of Loop
End Sub
 

cjms85

New Member
Joined
Jul 7, 2009
Messages
19
Hi Jeffrey,
That's a great help. I've just tried running your updated code, and for 1000 rows it took just 41 secs to run, compared to nearly 3.5 minutes with the old code. So that's a massive improvement!

I take your point about the variables being declared as integer. Since this is doing decimal calculations, should the be double instead?
Cheers,
Chris
 

cjms85

New Member
Joined
Jul 7, 2009
Messages
19
I've also changed these dimensions to double, and that's shaved another 10 secs off the total run time, taking it down to 30 sec for 1000 rows!
 

cjms85

New Member
Joined
Jul 7, 2009
Messages
19
I've tidied up the code a little more, incorporating most of your recommendations. I've change the Row, Col and Perc dimensions to Double, rather than integer. I've also included the disable events and screen updating, and re-enabled them at the end of the macro.

I took out the automatic calculations routine, as it actually resulted in the code printing the same result for each row.

Code:
Sub cmd_RunStats_Click()'
' Run Stats Macro
' Clear Data Table
    Range("U14:AS2013").ClearContents
' Turns off intensive processes
    Application.EnableEvents = False
    Application.ScreenUpdating = False
' Set Variables
    Dim Row As Double
    Dim Col As Double
    Dim Perc As Double
    Dim It As Integer
    Dim Col1 As Long
    Dim Col2 As Long
    Col1 = 21
    Col2 = 45
    Row = 13
    Col = 21
    Perc = 0
' Input Number of Iterations from Cell "T5"
    It = Cells(5, 20).Value
' Data Collection Loop for number of iterations
    Do While Row < (It + 13)
    ' Increment current storage Row and recalculate results
        Row = Row + 1
        Calculate
    ' No iteration needed
        Range(Cells(Row, Col1), Cells(Row, Col2)).Value = Range(Cells(7, Col1), Cells(7, Col2)).Value
    ' Calculate and display the percentage progress in Cell "U5"
        Perc = 100 * (Row / (It + 13)) 'CLUDGY FIX
        Cells(5, 21).Value = Perc
    Loop
' End of Loop
' Turns on intensive processes
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

If anyone can think of any other improvements, I'm all ears, but this is already much better than I had hoped for. Thank you!
 

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
2,081
Office Version
  1. 365
Platform
  1. Windows
Variables that control columns and rows should be LONG, not double. You only need an integer variable. But you do need a large integer for the number of rows in a worksheet. LONG variables also are more efficient when used in for loops where you incrementally increase the value.

I'd like to know what you're doing with the line in red below. Is this an interim result for the macro or does it change some results in your sheet? Why do you need to calculate each iteration? I'm wondering, for row 7, columns 21 through 45, can you not calculate your results using the macro. A macro can calculate 24 variables faster than you can calculate your entire workbook. I would imagine you should be able to cut this down to a few seconds rather than 30 seconds. Or, you can use the macro to create formulas.

I changed the Do Loop to a For Next loop. You can control ROW without an extra line of code. I would still turn off calculation, because you are calculating within the loop anyway. The red line adds one more workbook calc in the mix.

Code:
Sub cmd_RunStats_Click() '' Run Stats Macro
' Clear Data Table
    Range("U14:AS2013").ClearContents
' Turns off intensive processes
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
' Set Variables
    Dim Row As LONG
    Dim It As Integer
    Dim Col1 As Long
    Dim Col2 As Long
    Col1 = 21
    Col2 = 45
    Row = 13
' Input Number of Iterations from Cell "T5"
    It = Cells(5, 20).Value
' Data Collection Loop for number of iterations
     For Row = 14 to (It + 12)
      ' Increment current storage Row and recalculate results
        Calculate
      ' No iteration needed
        Range(Cells(Row, Col1), Cells(Row, Col2)).Value = Range(Cells(7, Col1), Cells(7, Col2)).Value
      ' Calculate and display the percentage progress in Cell "U5"
[COLOR=#ff0000]        Cells(5, 21).Value = 100 * (Row / (It + 13))[/COLOR]
    Next Row
' End of Loop
' Turns on intensive processes
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub
 

Forum statistics

Threads
1,175,794
Messages
5,899,535
Members
434,780
Latest member
andreeajc

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
Top