3
\$\begingroup\$

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).

Screenshot

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
\$\endgroup\$
0

2 Answers 2

3
\$\begingroup\$

So with this you're building the string that matches a named range in the sheet and then using it, hence -

If RangeExists(rangesum) = False Then Exit For

being in every case, Right? You can just use the boolean as your boolean -

If Not RangeExists(rangesum) Then Exit For

But you didn't define RangeExists so I can't be sure.


You also didn't type your function -

Private Function EstimateFunctions() As Long

(Long) Because you're returning a number. Also, why is the function a Private function if you're using out on the worksheet? Make that thing Public. You also didn't declare your variables and therefor didn't type those either.

 tempsum
 n
 temphrs
 finalsum
 temp1
 temp2

When you aren't declaring those you're running a dangerous game. Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

Also, name those variables something useful.

Dim rangeapproved As String
Dim rangesum As String

I expect these to be ranges with that name. Give me an idea of what it is - nameOfRangeToSum or something.

Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

These are commented out

'update1 As Range, update2 As Range

If you're not using them, remove them completely, it's just clutter.

Also putting a Select Case in a function that returns to the sheet, that doesn't sound right to me. I'm not sure why though.


For n = 1 To 10 Step 1

You don't need the Step 1 here, it's the default and isn't one of the things that you need to mention in code - it's redundant.

Also, all of those "" can be vbNullString - it's the constant to use when you want a null string.

\$\endgroup\$
2
\$\begingroup\$

Application.Volatile is only useful in UDFs and your image confirms this is how you are using it. Application.Volatile forces a recalculation whenever any cell in the worksheet is changed.

A UDF will selectively calculate when a target cell in the signature is changed, but your UDF (according to your image) does not reference a cell. Hence why you need Application.Volatile

One way around this is to have a cell that allows you to choose a string that reflects the options in your select case. Your UDF then takes this cell as an input and will recalculate every time this input is changed. In conjunction with this, your UDF can have, perhaps as the first signature, the cells for which the UDF is responsive to. You don't necessarily have to process that parameter within the UDF (but make sure you comment the reason why), but the UDF will also recalculate when any of these are changed.

While not directly related to your code, but influencing the design is your choice of named ranges. Instead of having Px_<Tag>, you could just have a single multi-cell range. This would allow you to remove a loop and just sum that range. Once you start refactoring this, your code will become clearer and cleaner.

e.g. =EstimateFunctions(C3,E10:U14,Cell_ContainingReportDate)

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.