Hello everyone.
I have been working on a UDF for a while to perform several SUMIFS and I was wondering if there is a ways to improve performance on it. So far the fastest one I have is by using purely Excel formulas but I want to simplify the way data is used for the comparisons.
I have come up with three different ways to do this with U_UDF_GetData3 been the fastest. In general anything that uses "Evaluate" would run slower that the rest.
Any ideas on how I could achieve this ?
Here are all my tries:
Summary
Function Time in Milliseconds U_UDF_GetData1 0.8965 U_UDF_GetData2 0.5693 U_UDF_GetData3 0.5064 Using Default Functions 0.1478
Number One
Time: ~ 0.8965 ms
Number TwoPublic Function U_UDF_GetData1(ByVal strSheetName As String, _ ByVal sColumnToMatch As String, _ ByVal sColumnWithData As String, _ ByRef varLabels As Variant) As Double Const strDIVIDER As String = "|" Dim arrLabels As Variant Dim i As Long Dim ret As Double On Error GoTo Error_Handler Application.Volatile True ' Set the sheet, fix the columns and populate the array. sColumnToMatch = sColumnToMatch & ":" & sColumnToMatch sColumnWithData = sColumnWithData & ":" & sColumnWithData ' Determine if the values are a string or a range. If TypeName(varLabels) = "Range" Then arrLabels = Split(varLabels.Value, strDIVIDER) ElseIf TypeName(varLabels) = "String" Then arrLabels = Split(varLabels, strDIVIDER) End If Dim strFormula As String Dim strSection As String ' Aggregate the items. For i = LBound(arrLabels) To UBound(arrLabels) strSection = "SUMIF('" & strSheetName & "'!" & sColumnToMatch & ",""" & arrLabels(i) & """,'" & strSheetName & "'!" & sColumnWithData & ")" If strFormula = vbNullString Then strFormula = strSection Else strFormula = strFormula & "+" & strSection End If Next i ret = Evaluate(strFormula) Exit_Handler: On Error GoTo 0 ' Return the value U_UDF_GetData1 = ret Exit Function Error_Handler: ret = 0 Resume Exit_Handler End Function
Time: ~ 0.5693 ms
Number ThreePublic Function U_UDF_GetData2(ByVal strSheetName As String, _ ByVal sColumnToMatch As String, _ ByVal sColumnWithData As String, _ ByRef varLabels As Variant) As Double Const strDIVIDER As String = "|" Dim sh As Worksheet Dim shFunction As WorksheetFunction Dim strArray As Variant Dim i As Long Dim ret As Double On Error GoTo Error_Handler Application.Volatile True ' Set the sheet, fix the columns and populate the array. Set shFunction = Application.WorksheetFunction Set sh = ThisWorkbook.Sheets(strSheetName) sColumnToMatch = sColumnToMatch & ":" & sColumnToMatch sColumnWithData = sColumnWithData & ":" & sColumnWithData ' Determine if the values are a string or a range. If TypeName(varLabels) = "Range" Then strArray = Join(Split(varLabels.Value, strDIVIDER), """,""") ElseIf TypeName(varLabels) = "String" Then strArray = Join(Split(varLabels, strDIVIDER), """,""") End If Dim strSection As String strSection = "SUM(SUMIF('" & strSheetName & "'!" & sColumnToMatch & ",{""" & strArray & """},'" & strSheetName & "'!" & sColumnWithData & "))" ret = Evaluate(strSection) Exit_Handler: On Error GoTo 0 ' Return the value U_UDF_GetData2 = ret Exit Function Error_Handler: ret = 0 Resume Exit_Handler End Function
Time: ~ 0.5064 ms
Public Function U_UDF_GetData3(ByVal strSheetName As String, _ ByVal sColumnToMatch As String, _ ByVal sColumnWithData As String, _ ByRef varLabels As Variant) As Double Const strDIVIDER As String = "|" Dim sh As Worksheet Dim shFunction As WorksheetFunction Dim arrLabels As Variant Dim i As Long Dim ret As Double On Error GoTo Error_Handler Application.Volatile True ' Set the sheet, fix the columns and populate the array. Set shFunction = Application.WorksheetFunction Set sh = ThisWorkbook.Sheets(strSheetName) sColumnToMatch = sColumnToMatch & ":" & sColumnToMatch sColumnWithData = sColumnWithData & ":" & sColumnWithData ' Determine if the values are a string or a range. If TypeName(varLabels) = "Range" Then arrLabels = Split(varLabels.Value, strDIVIDER) ElseIf TypeName(varLabels) = "String" Then arrLabels = Split(varLabels, strDIVIDER) End If ' Aggregate the items. For i = LBound(arrLabels) To UBound(arrLabels) ret = ret + shFunction.SumIf(sh.Range(sColumnToMatch), arrLabels(i), sh.Range(sColumnWithData)) Next i Exit_Handler: On Error GoTo 0 ' Return the value U_UDF_GetData3 = ret Exit Function Error_Handler: ret = 0 Resume Exit_Handler End Function







Reply With Quote