VBA UDF SUMIF with Array Parameters

A couple of things I have noticed (and I haven't tested the code):

• If you make the return value a Variant, instead of Long, you can also pass Excel Errors (e.g. #VALUE!) as a result from the UDF. This would be particular useful if IfPossible is False.
• You set OPERATORS up as a constant so you can check the validity of an input. But you don't use the string position at all. So, instead of Const OPERATORS As String = ">,<,<>,=", you can simply have Const OPERATORS As String = "<>=" which covers <, >, <> and =.
• Having set and used OPERATORS, you only check the 1st character, so <> will never be matched.
• You don't want to check for <= and `>=' as well?

Codewise:

 If Not UBound(criteriaArray, 1) = UBound(critRangeArray, 1) Then isPossible = False Else: isPossible = True End If 

Can be simplified to

isPossible = (UBound(criteriaArray, 1) = UBound(critRangeArray, 1)) 

Similarily:

If IsEmpty(criteriaArray) Then isPossible = False Else: isPossible = True End If 

can be simplified to:

isPossible = Not IsEmpty(criteriaArray) 

That entire If-Then-Else block can become:

If Not IsArray(criteriaArray) Then isPossible = Not IsEmpty(criteriaArray) Else isPossible = (UBound(criteriaArray, 1) = UBound(critRangeArray, 1)) End If 

Which, of course, you can turn around to get rid of the Not

If IsArray(criteriaArray) Then isPossible = (UBound(criteriaArray, 1) = UBound(critRangeArray, 1)) Else isPossible = Not IsEmpty(criteriaArray) End If 

Missing something here: Select Case isNumeric. That is not how the IsNumeric(val as variant) function is used. And given this is a Boolean result, a simple if-then statement will work. I am surprised this runs without throwing an error (I am taking your word for it that it works).

I am not going to go through it here (this answer is now long enough), but that case statement needs some serious rework. You have a lot of repetition and could probably get rid of at least two levels of nesting.

Here's what I noticed:

• Right now, you're looping through each cell in the sum range for each sheet and writing the results to an array. You actually do 3 reads per cell (once for Row, once for Column, once for Value2) on the sheet explicitly referenced by the range. This is really only necessary if the sum range is non-contiguous; otherwise, it's much faster to read in the entire range for each sheet. I'd change the function to either not accept non-contiguous ranges, or explicitly test to see if the range is non-contiguous. That way you could get good performance with normal use-cases (contiguous ranges) and still stay flexible. Something like this:

  Function isContiguous(ByRef rng As Range) As Boolean Dim returnVal As Boolean returnVal = False If rng.Areas.Count = 1 Then returnVal = True Else Dim rngArea As Range Dim rngUnion As Range For Each rngArea In rng.Areas If rngUnion Is Nothing Then Set rngUnion = rngArea Else Set rngUnion = Union(rngArea, rngUnion) End If Next If rngUnion.Areas.Count = 1 Then returnVal = True End If End If isContiguous = returnVal End Function 

• Since the sheet names are passed as a string, there's no guarantee that they actually exist. I'd probably test that before doing anything else in the function, and exit (or return some sort of descriptive error message) if any of the sheets don't exist. Here's a version of the sheet existence function that I use:

  Function sheetsExist(wb As Workbook, ByVal wsNames As Variant) As Boolean Dim i As Long Dim j As Long ReDim existingSheets(1 To wb.Sheets.Count) As Variant For i = LBound(existingSheets) To UBound(existingSheets) existingSheets(i) = UCase(wb.Sheets(i).Name) Next Dim toTest As Variant toTest = IIf(IsArray(wsNames), wsNames, Array(wsNames)) For i = LBound(toTest) To UBound(toTest) Dim uStr As String Dim goAhead As Boolean uStr = UCase(toTest(i)) goAhead = False For j = LBound(existingSheets) To UBound(existingSheets) If uStr = existingSheets(j) Then goAhead = True Exit For End If Next If Not goAhead Then sheetsExist = False Exit Function End If Next sheetsExist = True End Function 

• Your "criteria" parameter is passed as a Variant, but the first time it's accessed you reference its Value2 property, which only applies to Range objects. I'd either change the parameter type to Range, or test the parameter's type if you want the user to also be able to pass a comma-delimited string of criteria.

  If TypeName(criteria) = "Range" Then 'Convert to array with .Value2 ElseIf TypeName(criteria) = "String" Then 'Convert to array with Split Else Exit Function End If 

• Along those lines, something I've found helpful when writing functions that accept a variety of inputs for a single parameter (ie a Range, a String, an array of Strings) is to have some way of converting those inputs to a consistent format. That way, whether you're passed a reference to a single cell, a dozen cells, a single string, or an array of strings, they all turn into the same thing: a 1d array of base 1 (or 0, if you prefer). Here's a short function I wrote that looks like it could do that for both the "criteria" and "list_sheets" parameters so that they could accept a variety of input types. It uses one helper function for changing the base of 1d/2d arrays, and another for converting a "narrow" 2d array (ie with dimensions "1 to 10, 1 To 1" or "1 to 1, 1 to 10") into a 1d array (ie "1 to 10"). I use those two functions constantly so that I know that the arrays I'm working with will be predictable.

  Function convertParam(paramRef As Variant) As Variant 'If passed range, convert to 1D array (base 1) of values If TypeName(paramRef) = "Range" Then convertParam = narrow2dArray(paramRef.Value2) 'If passed array, convert to base 1 ElseIf IsArray(paramRef) Then convertParam = changeArrayBase(paramRef) 'If passed string, split and convert to base 1 ElseIf TypeName(paramRef) = "String" Then convertParam = changeArrayBase(Split(paramRef, ",")) End If End Function Function changeArrayBase(ByVal arr As Variant, Optional ByVal newBase As Long = 1) As Variant 'Changes base of 1D or 2D array (arr) to specified value (newBase) 'If arr is not an array, it is turned into a 1-element array containing the original value Dim tempArr As Variant Dim i As Long Dim j As Long Dim numDims As Long numDims = getDims(arr) If numDims = 0 Then ReDim tempArr(newBase To newBase) As Variant If IsObject(arr) Then Set tempArr(newBase) = arr Else tempArr(newBase) = arr End If ElseIf numDims = 1 Then ReDim tempArr(newBase To UBound(arr) - LBound(arr) + newBase) As Variant j = newBase For i = LBound(arr) To UBound(arr) If IsObject(arr(i)) Then Set tempArr(j) = arr(i) Else tempArr(j) = arr(i) End If j = j + 1 Next ElseIf numDims > 2 Then Exit Function Else Dim x As Long Dim y As Long x = UBound(arr, 1) - LBound(arr, 1) + newBase y = UBound(arr, 2) - LBound(arr, 2) + newBase ReDim tempArr(newBase To x, newBase To y) As Variant x = newBase For i = LBound(arr, 1) To UBound(arr, 1) y = newBase For j = LBound(arr, 2) To UBound(arr, 2) If IsObject(arr(i, j)) Then Set tempArr(x, y) = arr(i, j) Else tempArr(x, y) = arr(i, j) End If y = y + 1 Next x = x + 1 Next End If changeArrayBase = tempArr End Function Function narrow2dArray(ByRef arr As Variant, Optional ByVal newBase As Long = 1) As Variant 'Takes a 2d array which has one dimension of size 1 and converts it to a 1d array with base newBase 'IE it takes an array with these dimensions: 'Dim arr(1 To 10, 1 To 1) 'And turns it into an array with these dimensions: 'Dim arr(1 To 10) Dim bigDim As Integer Dim smallDim As Integer Dim numDims As Long numDims = getDims(arr) If numDims = 0 Then ReDim smallArr(newBase To newBase) As Variant smallArr(newBase) = arr narrow2dArray = smallArr Exit Function ElseIf numDims = 1 Then narrow2dArray = arr Exit Function ElseIf numDims > 2 Then Exit Function ElseIf LBound(arr, 1) = UBound(arr, 1) Then bigDim = 2 smallDim = 1 ElseIf LBound(arr, 2) = UBound(arr, 2) Then bigDim = 1 smallDim = 2 Else Exit Function End If ReDim tempArr(newBase To UBound(arr, bigDim) - LBound(arr, bigDim) + newBase) As Variant Dim i As Long Dim j As Long Dim k As Long j = LBound(arr, bigDim) k = LBound(arr, smallDim) If bigDim = 2 Then For i = LBound(tempArr) To UBound(tempArr) If IsObject(arr(k, j)) Then Set tempArr(i) = arr(k, j) Else tempArr(i) = arr(k, j) End If j = j + 1 Next Else For i = LBound(tempArr) To UBound(tempArr) If IsObject(arr(j, k)) Then Set tempArr(i) = arr(j, k) Else tempArr(i) = arr(j, k) End If j = j + 1 Next End If narrow2dArray = tempArr End Function Function getDims(x As Variant) As Long 'Gets number of dimensions of array 'If passed non-array, returns 0 On Error GoTo Err Dim i As Long Dim tempVal As Long i = 0 Do While True i = i + 1 tempVal = UBound(x, i) Loop Err: On Error GoTo 0 getDims = i - 1 End Function