I do not have much experience with VBA, and therefore need the help of this community for the following issue encountered.
I used Application.Volatile
in my code to run a series of calculation which slowed it down considerably. Without Application.Volatile
the code is fast enough for my purposes, but does not calculate/update row 8 (green row) when I change one of the input cells. Cell E8 (Image attached/ green row) references an estimate function which has several cases but will not update when any of cells in column E (or other columns) are changed without the use of Application.Volatile
.
So I am pretty sure what's causing it to slow down is Application.Volatile
, but I don't see a away around this. Anyway I can go around using Application.Volatile
, or what step should I take to make it run faster. I've tried a bunch of things but to no avail. I am considering to remove the functions completely and add formulas to those row 8 Cells (green).
Private Function EstimateFunctions(ByVal calc As String, Optional ByVal repdate As Date)
'update1 As Range, update2 As Range
Application.Volatile
Dim rangeapproved As String
Dim rangesum As String
tempsum = 0
Select Case calc
Case "SumHrs"
For n = 1 To 10 Step 1
rangesum = "P" + CStr(n) + "_RESOURCE_HOURS"
rangeapproved = "P" + CStr(n) + "_APPROVAL"
If RangeExists(rangesum) = False Then Exit For
If Range(rangeapproved).Value = "Y" Then
temphrs = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
Else
temphrs = 0
End If
If temphrs = "-" Then temphrs = 0
finalsum = finalsum + temphrs
Next n
If finalsum = 0 Then finalsum = ""
EstimateFunctions = finalsum
Case "SumQty"
For n = 1 To 10 Step 1
rangesum = "P" + CStr(n) + "_EXPENSE_QTY"
rangeapproved = "P" + CStr(n) + "_APPROVAL"
If RangeExists(rangesum) = False Then Exit For
If Range(rangeapproved).Value = "Y" Then
tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
Else
tempsum = 0
End If
If tempsum = "-" Then tempsum = 0
finalsum = finalsum + tempsum
Next n
If finalsum = 0 Then finalsum = ""
EstimateFunctions = finalsum
Case "SumActuals"
For n = 1 To 10 Step 1
rangesum = "P" + CStr(n) + "_ACTUALS_SUMMARY"
If RangeExists(rangesum) = False Then Exit For
tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
If tempsum = "" Then tempsum = 0
finalsum = finalsum + tempsum
Next n
EstimateFunctions = finalsum
Case "SumDateActuals"
For n = 1 To 10 Step 1
rangesum = "P" + CStr(n) + "_ACTUALS_DATECOST"
If RangeExists(rangesum) = False Then Exit For
tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
If tempsum = "" Then tempsum = 0
finalsum = finalsum + tempsum
Next n
EstimateFunctions = finalsum
Case "SumPerformance"
For n = 1 To 10 Step 1
rangesum = "P" + CStr(n) + "_PERFORMANCE_SUMMARY"
rangeapproved = "P" + CStr(n) + "_APPROVAL"
If RangeExists(rangesum) = False Then Exit For
If Range(rangeapproved).Value = "Y" Then
tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
Else
tempsum = 0
End If
If tempsum = "" Then tempsum = 0
finalsum = finalsum + tempsum
Next n
EstimateFunctions = finalsum
Case "SumEarnedValue"
For n = 1 To 10 Step 1
rangesum = "P" + CStr(n) + "_EARNED_VALUE"
rangeapproved = "P" + CStr(n) + "_APPROVAL"
If RangeExists(rangesum) = False Then Exit For
If Range(rangeapproved).Value = "Y" Then
tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
Else
tempsum = 0
End If
If tempsum = "-" Then tempsum = 0
finalsum = finalsum + tempsum
Next n
EstimateFunctions = finalsum
Case "SumPercentComplete"
For n = 1 To 10 Step 1
rangesum = "P" + CStr(n) + "_PERCENT_COMPLETE"
rangeapproved = "P" + CStr(n) + "_BUDGET_SUMMARY"
If RangeExists(rangesum) = False Then Exit For
temp1 = WorksheetFunction.Index(Range(rangeapproved), 0, 3).Value
temp2 = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
If temp2 = "" Then temp2 = 0
tempsum = temp1 * temp2
'If tempsum = "" Then tempsum = 0
finalsum = finalsum + tempsum
Next n
If finalsum = 0 Then
EstimateFunctions = ""
Else
EstimateFunctions = finalsum / WorksheetFunction.Index(Range("SUMMARY_BUDGET"), 0, 3)
End If
Case "SumActualExpense"
For n = 1 To 10 Step 1
rangesum = "P" + CStr(n) + "_ACTUAL_EXPENSES"
If RangeExists(rangesum) = False Then Exit For
tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
If tempsum = "" Then tempsum = 0
finalsum = finalsum + tempsum
Next n
EstimateFunctions = finalsum
Case "SumExpenseForecast"
For n = 1 To 10 Step 1
rangesum = "P" + CStr(n) + "_ACTUALS_SUMMARY"
If RangeExists(rangesum) = False Then Exit For
tempsum = WorksheetFunction.Index(Range(rangesum), 0, 4)
If tempsum = "" Then tempsum = 0
finalsum = finalsum + tempsum
Next n
EstimateFunctions = finalsum
Case "SumCont"
For n = 1 To 10 Step 1
rangesum = "P" + CStr(n) + "_LABOUR_SUMMARY"
If RangeExists(rangesum) = False Then Exit For
tempsum = WorksheetFunction.Index(Range(rangesum), 0, 5)
If tempsum = "" Then tempsum = 0
finalsum = finalsum + tempsum
Next n
EstimateFunctions = finalsum
End Select
End Function