Help Improve Complex Custom Function

[MartinS]

Hi
So I'm working on an Excel tool that is used by a large department, and one of the areas we are seeing slow speeds is running calculations for members and calculating cashflows. To help, we wrote a custom function Which I'll try and explain in better detail.

Function Udf_CalcCashflow(cashflowTotal() As Double, _
cashflowPBOTotal() As Double, _ 
pensionArray() As Variant, _
pensionType As String, _
decrementType As String, _
AgeNow As Long, _
Sex As Integer, _
Optional benefitOffset As Integer = -1)

'\* cashflowTotal() - array of cashflows that is 1 column by 100 rows
'\* cashflowPBOTotal() - array of cashflows that is 1 column by 100 rows
'\* pensionArray() - array of pensions that is one column by the number of years from age now to retirement
'\* pensionType - a string, such as "OP" (old age pension)
'\* decrementType - a string, such as "dth" (death)
'\* AgeNow - the age of the member
'\* Sex - the sex of the member (1 = M, 2 = F)
'\* benefitOffset - default is -1, value entered is a column offset position, i.e. 1

'\* declare variables at procedure level...
Dim x                   As Integer
Dim y                   As Integer
Dim cashflowCalc()      As Double
Dim cashflowPBOCalc()   As Double
Dim benefitAmt          As Double
Dim m_dDecrementRates() As Double
Dim tempcount           As Integer
Dim proRateFactor       As Double
'\* find the position of the items in the appropriate array...
'\* the following function returns the position in the array of known pension types, which will reflect the 'layer' 
'\* the pension type cashflows are held in.
Dim startPos            As Integer: startPos = Udf_FindPensionTypeStartPos(pensionType)
'\* the following function returns the position of the member's age in an array of all ages cashflows were requested for, 
'\* and therefore this also relates to a row/column position of the cashflows for the age and sex of the member.
Dim RecordPos           As Integer: RecordPos = Udf_FindAgePosition(AgeArray, AgeNow, Sex)
'\* if optional param not entered (the member is not active)...
If benefitOffset = -1 Then
'\* get a first value in the benefit array...
    benefitAmt = pensionArray(LBound(pensionArray, 1), 1)
'\* calculate the amount by each cashflow and store...
    For x = 1 To cMaxCashflowYears Step 1
        cashflowTotal(x, 1) = benefitAmt * Cashflows_GetSingleCashflow(RecordPos, startPos, 1, x - 1)
        cashflowPBOTotal(x, 1) = cashflowTotal(x, 1)
    Next x

'\* Notes: 
'\* cMaxCashflowYears = 100
'\* Cashflows_GetSingleCashflow(RecordPos, startPos, 1, x - 1) - the cashflows are in a multi-dimensional array, and this function returns a 
'\* single column of cashflows from the appropriate dimension (pension type, sex, age, year)
'\* End Notes
Else
'\* Notes: 
'\* cMaxAgeActive = 70
'\* m_dPlanEarlyRetEndAge = 65
'\* m_dDecrementRates is a single column of rates used in the calculations
'\* m_dnpx is a single column of rates used in the calculations
'\* End Notes
'\* get the appropriate rates for the calculation...
    m_dDecrementRates = Udf_GetDecrementRates(decrementType, AgeNow, Sex)
'\* redimension the array to hold the cashflow calcs...
    ReDim cashflowCalc(1 To cMaxCashflowYears, 1 To cMaxAgeActive - AgeNow + 2)
    ReDim cashflowPBOCalc(1 To cMaxCashflowYears, 1 To cMaxAgeActive - AgeNow + 2)
'\* calculate the cashflows and store the total...
    For y = LBound(pensionArray) + 1 To cMaxAgeActive - AgeNow + 2 Step 1
'\* if the year exceeds the maximum rows...
        If (AgeNow + y - 2) > cMaxAgeActive Then
'\* set the factor as 1...
            proRateFactor = 1
        Else
'\* get the pro-rate factor for the requested decrement type...
            Select Case decrementType
                Case "Term"
                    proRateFactor = svcProRates(AgeNow + y - 2, 2 * rateOffsetsTerm(1, benefitOffset) - 1)
                Case "Dis"
                    proRateFactor = svcProRates(AgeNow + y - 2, 2 * rateOffsetsDis(1, benefitOffset) - 1)
                Case "Dth"
                    proRateFactor = svcProRates(AgeNow + y - 2, 2 * rateOffsetsDth(1, benefitOffset) - 1)
                Case "Ret"
                    proRateFactor = svcProRates(AgeNow + y - 2, 2 * rateOffsetsRet(1, benefitOffset) - 1)
            End Select
        End If
        For x = 1 To cMaxCashflowYears Step 1
            If (x + y - 1) <= 100 Then
                If x = 1 And pensionType = "TOP Inpay" And decrementType = "Ret" And (AgeNow + y - 2) >= (m_dPlanEarlyRetEndAge - 1) And tempcount = 0 Then
                    startPos = Udf_FindPensionTypeStartPos("OP Inpay")
                    tempcount = tempcount + 1
                End If
'\* calculate the cashflow for the current year and pension type...
                cashflowCalc(x + y - 1, y) = pensionArray(y, 1) * Cashflows_GetSingleCashflow(RecordPos, startPos, y - 1, x - 1) * m_dDecrementRates(AgeNow + y - 2) * m_dnpx(AgeNow + y - 2)
'\* calculate the individual PBO cashflow...
                cashflowPBOCalc(x + y - 1, y) = cashflowCalc(x + y - 1, y) * proRateFactor
'\* sum the cashflows for the current year...
                cashflowTotal(x + y - 1, 1) = cashflowTotal(x + y - 1, 1) + cashflowCalc(x + y - 1, y)
                cashflowPBOTotal(x + y - 1, 1) = cashflowPBOTotal(x + y - 1, 1) + cashflowPBOCalc(x + y - 1, y)
            End If
        Next x
    Next y
End If
End Function

I appreciate the complexity of the function, it's an actuarial calculation that is being performed, and it's been written based on conversations with the product owner, but we both know that it's producing what seem to be the correct results. It would just be good if we could find a way to help it run faster. Am I missing anything obvious with regards the processing? Happy to provide more info if necessary, will do the best I can.
Many thanks in advance
Martin

 

[Kyle123]

Nothing looks particularly out of place, how bad is the performance?

What's the code for Udf_FindPensionTypeStartPos?

 

[MartinS]

Thanks. I've been moving the code inside the x loop that only uses y out (I'd already modified my code in the example above but hadn't run it), and over 5,000 records have saved 2 minutes. It's now taking over 4 minutes to run 5,000 records, but they are hoping to see a time of around 1-1 minute 15.

'\* get the appropriate rates for the calculation...
    m_dDecrementRates = Udf_GetDecrementRates(decrementType, AgeNow, Sex)
'\* get the decrement rate for the current age...
    dblDecRate = m_dDecrementRates(AgeNow + y - 2)
    dblNpx = m_dnpx(AgeNow + y - 2)
'\* get the pension amount for the current age...
    dblPensionAmt = pensionArray(y, 1)
'\* redimension the array to hold the cashflow calcs...
    ReDim cashflowCalc(1 To cMaxCashflowYears, 1 To cMaxAgeActive - AgeNow + 2)
    ReDim cashflowPBOCalc(1 To cMaxCashflowYears, 1 To cMaxAgeActive - AgeNow + 2)
'\* for all future ages...
    For y = LBound(pensionArray) + 1 To cMaxAgeActive - AgeNow + 2 Step 1
'\* if the year exceeds the maximum rows...
        If (AgeNow + y - 2) > cMaxAgeActive Then
'\* set the factor as 1...
            proRateFactor = 1
        Else
'\* get the pro-rate factor for the requested decrement type...
            Select Case decrementType
                Case "Term"
                    proRateFactor = svcProRates(AgeNow + y - 2, 2 * rateOffsetsTerm(1, benefitOffset) - 1)
                Case "Dis"
                    proRateFactor = svcProRates(AgeNow + y - 2, 2 * rateOffsetsDis(1, benefitOffset) - 1)
                Case "Dth"
                    proRateFactor = svcProRates(AgeNow + y - 2, 2 * rateOffsetsDth(1, benefitOffset) - 1)
                Case "Ret"
                    proRateFactor = svcProRates(AgeNow + y - 2, 2 * rateOffsetsRet(1, benefitOffset) - 1)
            End Select
        End If
'\* for all future years...
        For x = 1 To cMaxCashflowYears Step 1
            If (x + y - 1) <= 100 Then
                If x = 1 And pensionType = "TOP Inpay" And decrementType = "Ret" And (AgeNow + y - 2) >= (m_dPlanEarlyRetEndAge - 1) And tempcount = 0 Then
                    startPos = Udf_FindPensionTypeStartPos("OP Inpay")
                    tempcount = tempcount + 1
                End If
'\* calculate the cashflow for the current year and pension type...
                cashflowCalc(x + y - 1, y) = dblPensionAmt * Cashflows_GetSingleCashflow(RecordPos, startPos, y - 1, x - 1) * dblDecRate * dblNpx
'\* calculate the individual PBO cashflow...
                cashflowPBOCalc(x + y - 1, y) = cashflowCalc(x + y - 1, y) * proRateFactor
'\* sum the cashflows for the current year...
                cashflowTotal(x + y - 1, 1) = cashflowTotal(x + y - 1, 1) + cashflowCalc(x + y - 1, y)
                cashflowPBOTotal(x + y - 1, 1) = cashflowPBOTotal(x + y - 1, 1) + cashflowPBOCalc(x + y - 1, y)
            End If
        Next x
    Next y

The code for Udf_FindPensionTypeStartPos is:

Function Udf_FindPensionTypeStartPos(pensionType As String)
Dim pensionTypes    As Variant: pensionTypes = Array("OP", "NP", "TOP", "NP-RIS", "TPP", "OP Inpay", "NP Inpay", "TOP Inpay", "AOP Inpay", "TPP Inpay", "WZP Inpay")
Udf_FindPensionTypeStartPos = Application.Match(pensionType, pensionTypes, 0) - 1
End Function

The other search function is below - the ages are a single array made up of unique ages in the data set:

Function Udf_FindAgePosition(ArrayIn As Variant, SearchFor As Long, Sex As Integer)
Dim RecordPos As Integer: RecordPos = Application.Match(SearchFor, ArrayIn, 0) - 1
Udf_FindAgePosition = RecordPos + ((Sex - 1) * UBound(ArrayIn))
End Function

Hope this helps
Martin

 

[Kyle123]

Worksheet functions are typically slow on Arrays, try looping to match and see if it improves performance any I suspect it will - especially with the function being in a loop

 

[MartinS]

Worksheet functions are typically slow on Arrays, try looping to match and see if it improves performance any I suspect it will - especially with the function being in a loop

Thanks, I'll see what happens, especially as it calls both functions anything up 60+ times per call.

 

[MartinS]

Overall, moving the code about and swapping the function calls to loops (as per your suggestion), along with swapping out all IIFs in other code, I saved around 3 minutes on the same data set (5,000 records).
Still not what they were hoping for apparently, around 1m15s was expected - I don't think I can improve the function any further to gain that sort of time saving over 5,000 records, but will have to keep working at it I guess!
Thanks for the help/advice - appreciated
Regards
Martin