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