Worksheet functions in VBA - How do I speed up this macro?

Question

First of all, I´m a pretty new and ineffective VBA user, which you´ll definitely notice.

I have created a macro with loops that runs extremely slowly (about 10 minutes depending on the dataset, which differs in size every time) and I´m guessing that there´s a much better way of doing it than mine.

Basically, what I´m trying to do is automate a job that includes a lot of built-in functions in Excel. I got four columns and X amount of rows that need to be populated with formulas.

My idea was to calculate the formula for all four columns in row 1, then moving on to row 2 all the way to row X, using a simple "do loop". It looks something like this:


    Range("j2").Select
    rownumber = ActiveCell.Row

    Do

        'check if the cell on the left is empty to determine whether it´s the last row or not.

        Range("J" & rownumber).Select
        Range("J" & rownumber).Offset(0, -1).Select

        If IsEmpty(ActiveCell) = True Then        
            Exit Do        
        Else            
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = _                                   "=INDEX(Sheet1!C[-4],MATCH(Sheet2!R[0]C[-6],Sheet1!C[-9],0))"

            'next column

            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = _                                   "=INDEX(sheet1!C[-6],MATCH(sheet2!RC[-7],sheet1!C[-10],0))"

            'next column

            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = _                                   "=INDEX(sheet3!C[-10],MATCH(sheet2!RC[-2],sheet1!C[-11],0))*sheet2!RC[-1]*sheet2!RC[-10]"

            'next column

            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = _                                   "=IF(sheet2!RC[-12]=""BUY"",SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])+sheet2!RC[-11],SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])-sheet2!RC[-11])"            
            ActiveCell.Offset(0, 1).Select         
            rownumber = rownumber + 1        
        End If

    Loop

This all works, but there must be a better solution that runs smoother. I understand that Excel needs to do lots of calculations with the nested if statements, but it would probably take me less than 10 minutes to do this manually, so I´m guessing it´s my code that slows things up.

You can write formulas to an entire range in one go, instead of writing them cell by cell. — BigBen, Sep 19 '19 at 12:49
Start with this: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — z32a7ul, Sep 19 '19 at 12:49
Instead of recalculating the *entire* workbook every time you change a Formula, consider changing [the `Application.Calculation` property]https://learn.microsoft.com/en-us/office/vba/api/excel.application.calculation) to `xlCalculationManual` before you start, and back to `xlCalculationAutomatic` at the end - then it only has to calculate once! — Chronocidal, Sep 19 '19 at 12:57

z32a7ul · Answer 1 · 2019-09-19T13:11:10.963

I would modify your code this way:

Dim xlcOld As Calculation: xlcOld = Application.Calculation
Application.Calculation = xlCalculationManual

Dim rownumber As Long: rownumber = 2
Do While Not IsEmpty(Range("I" & rownumber).Value)
    Range("J" & rownumber).FormulaR1C1 = "=INDEX(Sheet1!C[-4],MATCH(Sheet2!R[0]C[-6],Sheet1!C[-9],0))"
    Range("K" & rownumber).FormulaR1C1 = "=INDEX(sheet1!C[-6],MATCH(sheet2!RC[-7],sheet1!C[-10],0))"
    Range("L" & rownumber).FormulaR1C1 = "=INDEX(sheet3!C[-10],MATCH(sheet2!RC[-2],sheet1!C[-11],0))*sheet2!RC[-1]*sheet2!RC[-10]"
    Range("M" & rownumber).FormulaR1C1 = "=IF(sheet2!RC[-12]=""BUY"",SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])+sheet2!RC[-11],SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])-sheet2!RC[-11])"
    rownumber = rownumber + 1
Loop

Application.Calculation = xlcOld

Note that:

Automatic recalculation is turned off, so only one recalculation is needed instead of 4 × rownumber calculations
Select operations are replaced with direct cell references

As BigBen indicated, it can be even more efficient by writing formulas in one go:

Dim xlcOld As Calculation: xlcOld = Application.Calculation
Application.Calculation = xlCalculationManual

Dim firstrow As Long: firstrow = 2
Dim lastrow As Long: lastrow = firstrow
Do While Not IsEmpty(Range("I" & lastrow).Value)
    lastrow = lastrow + 1
Loop
lastrow = lastrow - 1
Range("J" & firstrow & ":J" & lastrow).FormulaR1C1 = "=INDEX(Sheet1!C[-4],MATCH(Sheet2!R[0]C[-6],Sheet1!C[-9],0))"
Range("K" & firstrow & ":J" & lastrow).FormulaR1C1 = "=INDEX(sheet1!C[-6],MATCH(sheet2!RC[-7],sheet1!C[-10],0))"
Range("L" & firstrow & ":J" & lastrow).FormulaR1C1 = "=INDEX(sheet3!C[-10],MATCH(sheet2!RC[-2],sheet1!C[-11],0))*sheet2!RC[-1]*sheet2!RC[-10]"
Range("M" & firstrow & ":J" & lastrow).FormulaR1C1 = "=IF(sheet2!RC[-12]=""BUY"",SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])+sheet2!RC[-11],SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])-sheet2!RC[-11])"

Application.Calculation = xlcOld

Whether this adds significant benefit, depends on the actual data. I think most of the work comes from recalculations and not from modifying the formulas but if rownumber is a really big number a further enhancement may be possible.

Also, you could find the last row with Range.End(xlUp) but that depends on the actual layout of your sheet, so I did not remove the loop counting the number of rows.

Worksheet functions in VBA - How do I speed up this macro?

1 Answers1