CODEWITHSUNDEEP
excelvba
ZaxR
ZaxR

Reputation: 5155

VBA Insert Formulas into Table Very Slow

I have a workbook that on open, turns the used cells into a table, and then injects different formulas into each column. I'm injecting the formulas to save file size from exploding by pre-dragging formulas down farther than needed. The VBA I have to do this works fine, but is incredibly slow. I've already run performance checks and can confirm that the slowness is caused by the formula injection (only 141 rows can be injected per second). I have already done the basic calculation/screen update related optimizations. What else can be done to speed up the following code? (Note I have reduced to the relevant portion of the code):

Sub OptimizeVBA(isOn As Boolean)
  Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
  Application.EnableEvents = Not(isOn)
  Application.ScreenUpdating = Not(isOn)
  ' ActiveSheet.DisplayPageBreaks = Not(isOn)
End Sub

Private Sub Workbook_Open()
    OptimizeVBA True

    Dim ws As Worksheet
    Set ws = Worksheets("Book1")
    Dim tbl As ListObject
    Set tbl = ws.ListObjects("Table1")

    tbl.ListColumns("Dollar Share ").DataBodyRange.Formula = "=IFERROR(([@[Dollar Share  ]] - MEDIAN([[Dollar Share  ]])) / STDEV.P([[Dollar Share  ]]), """")"
    tbl.ListColumns("Unit Share ").DataBodyRange.Formula = "=IFERROR(([@[Unit Share  ]] - MEDIAN([[Unit Share  ]])) / STDEV.P([[Unit Share  ]]), """")"
    tbl.ListColumns("Units PSPW ").DataBodyRange.Formula = "=IFERROR(([@[Units PSPW  ]] - MEDIAN([[Units PSPW  ]])) / STDEV.P([[Units PSPW  ]]), """")"
    tbl.ListColumns("Dollar Growth ").DataBodyRange.Formula = "=IFERROR(IF(OR([@[Dollar Growth  ]] = """", [@[Dollars, Yago]] < New_Item_Floor), """", ([@[Dollar Growth  ]] - MEDIAN([[Dollar Growth  ]])) / STDEV.P([[Dollar Growth  ]])), """")"
    tbl.ListColumns("Unit Growth ").DataBodyRange.Formula = "=IFERROR(IF(OR([@[Unit Growth  ]] = """", [@[Dollars, Yago]] < New_Item_Floor), """", ([@[Unit Growth  ]] - MEDIAN([[Unit Growth  ]])) / STDEV.P([[Unit Growth  ]])), """")"
    tbl.ListColumns("Comp Avg % ACV ").DataBodyRange.Formula = "=IFERROR(([@[Comp Avg % ACV  ]] - MEDIAN([[Comp Avg % ACV  ]])) / STDEV.P([[Comp Avg % ACV  ]]), """")"

    OptimizeVBA False
End Sub

I'm aware that selects/other interactions with Excel objects are expensive, but given that the above formulas are different, I couldn't figure out an easy way to reduce the separate interactions for each column.

Notes:

Thanks in advance for the help!

Upvotes: 0

Views: 1467

Answers (3)

xidgel
xidgel

Reputation: 3145

One source of the slowness could be the use of the MEDIAN function --- it's more expensive/slow to calculate than AVERAGE.

In quick and dirty testing on my hardware using 16K rows of fake date and with Calculations, Events and ScreenUpdating all Enabled (no speedups), your formula

=IFERROR(([@[Dollar Share  ]] - MEDIAN([[Dollar Share  ]])) / STDEV.P([[Dollar Share  ]]), "")

took 5.4 seconds to execute, but when AVERAGE is used instead of MEDIAN

=IFERROR(([@[Dollar Share  ]] - AVERAGE([[Dollar Share  ]])) / STDEV.P([[Dollar Share  ]]), "")

it ran in 0.8 seconds, a speed-up of ~6.6X.

The problem is compounded by the fact that the same MEDIAN and STDEV.P get (wastefully) recalculated 16K times (once for each row of the table). It doesn't appear that the Excel calculation engine optimizes for this. You should be able to speed up your tables by calculating these values ONLY ONCE and then re-using.

One way to do this is to add a Totals row to the table and use MEDIAN as the total function. Then if your code is:

Sheet1.ListObjects("Table1").ListColumns("Dollar Share ").DataBodyRange.Formula = "=IFERROR(([@[Dollar Share  ]] - Table1[[#Totals],[Dollar Share  ]]) / STDEV.P([[Dollar Share  ]]), """")"

the run time gets reduced to 0.52 seconds, a 10X improvement. You could also have helper cells on your worksheet to hold all of the MEDIAN and STDEV.P values; this should give an even greater speed-up.

Hope that helps.

Upvotes: 2

Mohamad TAGHLOBI
Mohamad TAGHLOBI

Reputation: 591

You can try to calculate dynamically the last row, if you ignore in advance its value, and so try to apply the formula to active cells and then autofill the formula to this last row of the specified column.

  Sub ExtendFormula()
  .
  .
  Dim Limit As Long 'Instead of Integer : Thanks to BigBen for it's recommendation
  Application.ScreenUpdating = False 
  Limit = Range("A" & Rows.Count).End(xlUp).Row 
  Range("B5").Formula = "=A5+2*B5" 
  Range("B5").AutoFill Destination:=Range("B5:B" & Limit)
  .
  .
  End Sub

Hope that can help you

Upvotes: 0

SnowGroomer
SnowGroomer

Reputation: 695

I'll provide you with my tests here, as this is too much code for comments.

I changed your code in order to paste formulas directly. I tested as strings (due to lack of your table setup) and it is basically immediate. So there must be some table-related shenanigans happening. Please try in your table. You will just need to adjust ranges/worksheet to your needs:

Private Sub Workbook_Open()
    OptimizeVBA True

    Dim ws As Worksheet
    Set ws = ActiveSheet


    ws.Range("A2:A200000").Formula = "=IFERROR(([@[Dollar Share  ]] - MEDIAN([[Dollar Share  ]])) / STDEV.P([[Dollar Share  ]]), """")"
    ws.Range("B2:B200000").Formula = "=IFERROR(([@[Unit Share  ]] - MEDIAN([[Unit Share  ]])) / STDEV.P([[Unit Share  ]]), """")"
    ws.Range("C2:C200000").Formula = "=IFERROR(([@[Units PSPW  ]] - MEDIAN([[Units PSPW  ]])) / STDEV.P([[Units PSPW  ]]), """")"
    ws.Range("D2:D200000").Formula = "=IFERROR(IF(OR([@[Dollar Growth  ]] = """", [@[Dollars, Yago]] < New_Item_Floor), """", ([@[Dollar Growth  ]] - MEDIAN([[Dollar Growth  ]])) / STDEV.P([[Dollar Growth  ]])), """")"
    ws.Range("E2:E200000").Formula = "=IFERROR(IF(OR([@[Unit Growth  ]] = """", [@[Dollars, Yago]] < New_Item_Floor), """", ([@[Unit Growth  ]] - MEDIAN([[Unit Growth  ]])) / STDEV.P([[Unit Growth  ]])), """")"
    ws.Range("F2:F200000").Formula = "=IFERROR(([@[Comp Avg % ACV  ]] - MEDIAN([[Comp Avg % ACV  ]])) / STDEV.P([[Comp Avg % ACV  ]]), """")"

    OptimizeVBA False
End Sub

Your question from comments: how you could use autofill for such a task:

Sub autof()
    Cells(1, 1).Value = 1
    Cells(1, 2).Value = 2
    Range(Cells(1, 1), Cells(1, 2)).AutoFill Range(Cells(1, 1), Cells(10, 2)), xlFillCopy
End Sub

Upvotes: 2

Related Questions