0

Please refer attached Image below. VBA code is taking more than 30 minutes to update the formula in Column F till the last row based on latest quarter information.

enter image description here

For Example, if I have Q1 data and Q2 data then formula should calculate based on Q2 data as it is the latest quarter. This a main requirement.

I have done the below things.

1) Created a Named rages for each quarter/Column
Q1 =OFFSET(Data!$B$2;0;0;COUNTA(Data!$A:$A)-1;1);
Q2 =OFFSET(Data!$C$2;0;0;COUNTA(Data!$A:$A)-1;1);
Q3 =OFFSET(Data!$D$2;0;0;COUNTA(Data!$A:$A)-1;1);
Q4 =OFFSET(Data!$E$2;0;0;COUNTA(Data!$A:$A)-1;1);

2) Now in Column F I have included the following IF condition through VBA code=IF(Q4_Range>0;E2;IF(Q3_Range>0;D2;IF(Q2_Range>0;C2;IF(Q1_Range>0;B2;""))))

This is how it looks in the VBA editor
ActiveCell.FormulaR1C1 =_ "=IF(Q4_Range>0,RC[-1],IF(Q3_Range>0,RC[-2],IF(Q2_Range>0,RC[-3],IF(Q1_Range>0,RC[-4],""""))))"

When I run the VBA code it is taking more than 30 minutes to copy this formula till the last row which is dynamic and will be around 50,000 to 80,000 rows.

My Complete Code 

Sub Add_Formula()

Dim Sht As Worksheet
Dim LastRow As Long

    Set StartCell = Range("A2")

    LastRow = Sht.Cells(Sht.Rows.Count, StartCell.Column).End(xlUp).Row

      Range("F2:F" & LastRow).Select
      Range("F2:F" & LastRow).FormulaR1C1 = "=IF(FF3_RANGE>0,RC[-1],IF(FF2_RANGE>0,RC[-2],IF(FF1_RANGE>0,RC[-3],IF(FF0_RANGE>0,RC[-4],))))"

      Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"

End Sub

Is there a way to speed-up process by changing the VBA code?

user3186707
  • 101
  • 9

1 Answers1

2

Here are a few things that can help:

  1. If all you need in Column F is the value of the latest quarter (cells Bx:Ex), then you can simplify your formula without using dynamic named ranges. This answer shows several options for you, but since you're almost certainly looking at numbers, the formula in column F should be =LOOKUP(9.99E+307,$B2:$E2).
  2. You've got the right approach to apply the formula using VBA (which would be =LOOKUP(9.99E+307,RC2:RC5)), but you should always avoid using Select or Activate.
  3. The real key in speeding up your process is to disable screen updates and automatic calculation.

Wrapped all together as an example:

Option Explicit

Sub Add_Formula()
    ToggleAppUpdates False
    Dim Sht As Worksheet
    Set Sht = Worksheets("Sheet1")
    With Sht
        Dim startCell As Range
        Set startCell = .Range("A2")
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, startCell.Column).End(xlUp).Row
        With .Range("F2:F" & lastRow)
            .FormulaR1C1 = "=LOOKUP(9.99E+307,RC2:RC5)"
            .NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
        End With
    End With
    ToggleAppUpdates True
End Sub

Sub ToggleAppUpdates(ByVal state As Boolean)
    With Application
        .ScreenUpdating = state
        .Calculation = IIf(state, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub
PeterT
  • 8,232
  • 1
  • 17
  • 38