VBA Formula Instead of FormulaR1C1

62 Views Asked by At

Following code works as intended. However I am trying to avoid copying the formulas in each cell inside my FormulaArray using FormulaR1C1. It slows down my data collection in my other array. Because after I collect 50,000 rows of data each time the Worksheet Calculate function fires it recalculates all those cells w/ the copied formulas. Is there a way to do arithmetic within VBA and not copy the formulas to the excel grid?

Goal is to use VBA to get my result and print JUST the results to With Sheet2.Cells(NextRow, "H").Resize(, UBound(FormulaArray) + 1) Sheet2.Cells(NextRow, "H").Resize(, UBound(FormulaArray) + 1)

Formulas 1 thru 6 are copied over and over again in the excel grid. Maybe use Application.Evaluate or Application.WorksheetFunction? Then when the Worksheet Calculate fires it will not have to recalculate all those formulas (over 300k) because they are no longer in the cells only their results.

Private Sub Worksheet_Calculate()

    Dim keyCells As Range
    Dim i As Long
    Dim diff As Long
    Dim ckey As Range
    Dim FormulaArray As Variant, ValueArray As Variant
    Dim timec As String
    Dim Formula1 As String, Formula2 As String, Formula3 As String, Formula4 As String, Formula5 As String, Formula6 As String

    If Worksheets("Dashboard").ToggleButton1.Value = True Then
        On Error GoTo SafeExit
            Application.Calculation = xlCalculationManual: Application.EnableEvents = False: Application.ScreenUpdating = False

    Formula1 = "=IF(RC[-6]<=RC[-7],RC[-6]*RC[-3],0)"
    Formula2 = "=IF(RC[-7]>=RC[-6],RC[-7]*RC[-4],0)"
    Formula3 = "=IF(RC[-9]>RC[-7],0,IF(RC[-9]=RC[-7],0,IF(AND(RC[-2]=0,RC[-1]=0),IF(ROUND(ABS(RC[-8]-RC[-9]),2)<ROUND(ABS(RC[-7]-RC[-8]),2),RC[-8]*RC[-5],0),0)))"
    Formula4 = "=IF(RC[-10]>RC[-8],0,IF(RC[-10]=RC[-8],0,IF(AND(RC[-3]=0,RC[-2]=0),IF(ROUND(ABS(RC[-9]-RC[-8]),2)<ROUND(ABS(RC[-9]-RC[-10]),2),RC[-9]*RC[-6],0),0)))"
    Formula5 = "=RC[-4]+RC[-2]"
    Formula6 = "=RC[-4]+RC[-2]"


'BA-1
        Set keyCells = Me.Range("E3:E4")
            For i = 1 To UBound(myArr)
                Set ckey = keyCells(i, 1)
                timec = Worksheets("Dashboard").Range("A1").Value
                
                If ckey.Value <> myArr(i, 1) Then
                    diff = (ckey.Value - myArr(i, 1))
                    NextRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1

                    ValueArray = Array(Me.Cells(i + 2, "A").Value, Me.Cells(i + 2, "B").Value, Me.Cells(i + 2, "C").Value, _
                            Me.Cells(i + 2, "D").Value, diff, Me.Cells(i + 2, "E").Value, timec)

                    With Sheet2.Cells(NextRow, "A").Resize(, UBound(ValueArray) + 1)
                        .Value = ValueArray
                    End With
                    
                    FormulaArray = Array(Formula1,Formula2, Formula3, Formula4, Formula5, Formula6)
                     
                    With Sheet2.Cells(NextRow, "H").Resize(, UBound(FormulaArray) + 1)
                        .FormulaR1C1 = FormulaArray
                    End With
                    
                    NextRow = NextRow + 1
                End If
            Next i
End If
SafeExit:
    Application.Calculation = xlCalculationAutomatic: Application.EnableEvents = True: Application.ScreenUpdating = True

    Call PopulateBA: 
End Sub

Example of Output Current State in Cells:

A2 = 10.00 
B2 = 9.50 
C2 = 11.00 
D2 = 5 
E2 = 2 
F2 = 200 
G2 = 4 
H2 =IF(B2<=A2,B2xE2,0) = 19 
I2 =IF(B2>=C2,B2xE2,0) = 0 
J2 =IF(A2>C2,0,IF(A2=C2,0,IF(AND(H2=0,I2=0),IF(ROUND(ABS(B2-A2),2 <ROUND(ABS(C2-B2),2),B2xE2,0),0))) = 0
K2 =IF(A2>C2,0,IF(A2=C2,0,IF(AND(H2=0,I2=0),IF(ROUND(ABS(B2-C2),2)<ROUND(ABS(B2-A2),2),B2xE2,0),0))) = 0 
L2 =H2+J2 = 19 
M2 =I2+K2 = 0

Example of Output Future State in Cells:

A2 = 10.00 
B2 = 9.50 
C2 = 11.00
D2 = 5
E2 = 2
F2 = 200 
G2 = 4 
H2 = 19 
I2 = 0
J2 = 0
K2 = 0 
L2 = 19 
M2 = 0
0

There are 0 best solutions below