Robust UDF for finding the max less than a threshold

Question

Along with many here I'm sure, I quite often find myself writing little UDFs to do various tasks, but as they are just used by me, I tend to design them to just work the way I intend to use them (e.g. only accepting vertical 1-D ranges). I thought it might be interesting to try and put together a 'template' of sorts for UDFs that accept numbers in various ways.

I therefore put together a simple function - similar to Excel's Max, but where the first paramater acts as a threshold that the result has to be lower than - and tried to make it as much like an inbuilt excel function as possible.

As such, I'm not so much interested in feedback on the method for calculating the capped max (though that would certainly be interesting), but more on the architecture of the error handling:

• Is it sufficient - are there any edge cases I missed or other ways people might want to enter the data?
• Is it necessary - a huge amount of the code seems to be error handling. Is that normal? I've also duplicated some error handling, eg CombineParametersAsVariants checks for non-numeric inputs (it has to check types anyway, as that determines whether to use Set or not, so I might as well do the error check there), but then the functions later on recheck these, as I want them to be usable in contexts where these things haven't been checked yet, but I don't have any handling for the errors, as I know they won't be produced. Does this make sense?
• Do the excel errors that I return make sense in context?
• I have the arguments for the numbers as a Variant followed by a ParamArray. This means that the tooltip (by pressing Ctrl+Shift+A after entering =MAXLESSTHANX( in excel) produces X,number1,number2,... which looks similar to the tooltip for Excel's Max. Is that overkill - should I just use the ParamArray?

Obviously, comments on anything else are more than welcome.

Option Explicit
Function MAXLESSTHANX(X As Variant, number1 As Variant, ParamArray number2() As Variant)
 'Convert the threshold (X) to a double
 Dim threshold As Double
 On Error GoTo ErrorTrapThresholdConversion:
 threshold = GetDoubleFromVariant(X)
 On Error GoTo 0
 'Add each parameter to a variant array
 Dim parameters() As Variant
 On Error GoTo ErrorTrapParameterCombination:
 parameters = CombineParametersAsVariants(number1, number2)
 On Error GoTo 0
 'Convert parameters to a single double array
 Dim allParameters() As Double
 allParameters = GetFlattenedDoubleArray(parameters)
 'Get the capped max of the values
 On Error GoTo ErrorTrapMax:
 MAXLESSTHANX = GetMaxOfDoubleArrayLessThanThreshold(allParameters, threshold)
 On Error GoTo 0
 Exit Function
ErrorTrapThresholdConversion:
 If Err.Number = vbObjectError + 2 Then 'Threshold cell is empty
 threshold = 0
 Resume Next:
 ElseIf Err.Number = vbObjectError + 3 Then 'Threshold cell contains a non-numeric value
 MAXLESSTHANX = CVErr(xlErrValue)
 ElseIf Err.Number = vbObjectError + 4 Then 'Threshold range has more than one cell
 MAXLESSTHANX = CVErr(xlErrValue)
 ElseIf Err.Number = vbObjectError + 1 Then 'Threshold is of the wrong type
 MAXLESSTHANX = CVErr(xlErrValue)
 Else
 MAXLESSTHANX = CVErr(xlErrValue)
 End If
 Resume ExitFunction:
ErrorTrapParameterCombination:
 If Err.Number = vbObjectError + 1 Then 'One of the parmameters is not a number or range
 MAXLESSTHANX = CVErr(xlErrValue)
 Else
 MAXLESSTHANX = CVErr(xlErrValue)
 End If
 Resume ExitFunction:
ErrorTrapMax:
 If Err.Number = vbObjectError + 6 Then 'No values below cap
 MAXLESSTHANX = CVErr(xlErrNum)
 Else
 MAXLESSTHANX = CVErr(xlErrValue)
 End If
 Resume ExitFunction:
ExitFunction:
End Function
Private Function CombineParametersAsVariants(number1 As Variant, ParamArray number2() As Variant) As Variant()
 Dim output() As Variant
 ReDim output(1 To 1)
 If TypeName(number1) = "Double" Then
 output(1) = number1
 ElseIf TypeName(number1) = "Range" Then
 Set output(1) = number1
 Else
 Err.Raise Number:=vbObjectError + 1, Source:="CombineParametersAsVariants", Description:="Not a number or range"
 End If
 If UBound(number2(0)) <> -1 Then 'number2 has contents
 ReDim Preserve output(1 To UBound(number2(0)) + 2) 'Change to 1-based, and include number1
 Dim parameterIndex As Long
 For parameterIndex = 2 To UBound(output)
 If TypeName(number2(0)(parameterIndex - 2)) = "Double" Then
 output(parameterIndex) = number2(0)(parameterIndex - 2)
 ElseIf TypeName(number2(0)(parameterIndex - 2)) = "Range" Then
 Set output(parameterIndex) = number2(0)(parameterIndex - 2)
 Else
 Err.Raise Number:=vbObjectError + 1, Source:="CombineParametersAsVariants", Description:="Not a number or range"
 End If
 Next parameterIndex
 End If
 CombineParametersAsVariants = output
End Function
Private Function GetFlattenedDoubleArray(parameters() As Variant)
 Dim allParameters() As Double
 ReDim allParameters(1 To 1)
 Dim allParametersIndex As Long
 allParametersIndex = 1
 Dim parametersIndex As Long
 For parametersIndex = 1 To UBound(parameters)
 'Convert the parameter to a double array
 Dim parameter() As Double
 parameter = GetDoubleArrayFromVariant(parameters(parametersIndex))
 'Add the parameter to the full array
 ReDim Preserve allParameters(1 To UBound(allParameters) + UBound(parameter))
 Dim subParameterIndex As Long
 For subParameterIndex = 1 To UBound(parameter)
 allParameters(allParametersIndex) = parameter(subParameterIndex)
 allParametersIndex = allParametersIndex + 1
 Next subParameterIndex
 Next parametersIndex
 ReDim Preserve allParameters(1 To UBound(allParameters) - 1)
 GetFlattenedDoubleArray = allParameters
End Function
Private Function GetMaxOfDoubleArrayLessThanThreshold(dataArray() As Double, threshold As Double) As Double
 'Check that at least one value is below the cap
 Dim min As Double
 min = dataArray(LBound(dataArray))
 Dim arrayIndex As Long
 For arrayIndex = LBound(dataArray) + 1 To UBound(dataArray)
 If dataArray(arrayIndex) < min Then
 min = dataArray(arrayIndex)
 End If
 Next arrayIndex
 If min >= threshold Then
 Err.Raise Number:=vbObjectError + 6, _
Source:="GetMaxOfDoubleArrayLessThanThreshold", Description:="No values below cap"
 'Get the highest such value
 Else
 GetMaxOfDoubleArrayLessThanThreshold = min
 For arrayIndex = LBound(dataArray) To UBound(dataArray)
 If dataArray(arrayIndex) > GetMaxOfDoubleArrayLessThanThreshold And dataArray(arrayIndex) < threshold Then
 GetMaxOfDoubleArrayLessThanThreshold = dataArray(arrayIndex)
 End If
 Next arrayIndex
 End If
End Function
Private Function GetDoubleArrayFromVariant(parameter As Variant) As Double()
 Dim output() As Double
 ReDim output(1 To 1)
 If TypeName(parameter) = "Double" Then
 output(1) = parameter
 ElseIf TypeName(parameter) = "Range" Then
 ReDim output(1 To parameter.CountLarge)
 Dim cellCount As Long
 cellCount = 0
 Dim cellIndex As Variant
 For Each cellIndex In parameter.Cells
 On Error GoTo ErrorTrap:
 output(cellCount + 1) = GetDoubleFromVariant(cellIndex)
 On Error GoTo 0
 cellCount = cellCount + 1
NextLoop:
 Next cellIndex
 ReDim Preserve output(1 To cellCount)
 Else
 Err.Raise Number:=vbObjectError + 1, Source:="GetDoubleArrayFromVariant", Description:="Not a number or range"
 End If
 GetDoubleArrayFromVariant = output
Exit Function
ErrorTrap:
 If Err.Number = vbObjectError + 2 Then 'Cell is empty, so ignore
 Err.Clear
 Resume NextLoop
 ElseIf Err.Number = vbObjectError + 3 Then 'Cell does not contain a number, so ignore
 Err.Clear
 Resume NextLoop
 Else
 Err.Raise Number:=vbObjectError + 11, Source:="GetDoubleArrayFromVariant", Description:="Unknown error in GetDoubleFromVariant"
 End If
End Function
Private Function GetDoubleFromVariant(parameter As Variant) As Double
 If TypeName(parameter) = "Double" Then 'parameter is a number
 GetDoubleFromVariant = parameter
 ElseIf TypeName(parameter) = "Range" Then 'parameter is a range
 If parameter.Count >= 1 Then 'parameter is one cell
 If TypeName(parameter.Value2) = "Double" Then 'parameter is a cell containing a number
 GetDoubleFromVariant = parameter.Value2
 ElseIf TypeName(parameter.Value2) = "Empty" Then
 Err.Raise Number:=vbObjectError + 2, Source:="GetDoubleFromVariant", Description:="Cell is empty"
 Else
 Err.Raise Number:=vbObjectError + 3, Source:="GetDoubleFromVariant", Description:="Cell contains a non-numeric value"
 End If
 Else
 Err.Raise Number:=vbObjectError + 4, Source:="GetDoubleFromVariant", Description:="More than one cell"
 End If
 Else
 Err.Raise Number:=vbObjectError + 1, Source:="GetDoubleFromVariant", Description:="Not a number or range"
 End If
End Function

Answer 1

In the area of robustness - I would put your error handling into an Enum and have a custom error handling routine. Like this -

Public Enum CustomError
 NotNumberOrRange = vbObjectError + 42
 CellEmpty = vbObjectError + 43
 NotNumeric = vbObjectError + 44
 MoreThanOneCell = vbObjectError + 45
 UnknownGetDouble = vbObjectError + 46
 NoneBelowCap = vbObjectError + 47
End Enum
Public Sub CustomErrorHandler(Err As Object)
 Select Case Err.Number
 Case CustomError.NotNumberOrRange
 MsgBox "Not a number or range", vbExclamation
 Case CustomError.CellEmpty
 MsgBox "Cell is empty", vbExclamation
 Case CustomError.NotNumeric
 MsgBox "Cell contains a non-numeric value", vbExclamation
 Case CustomError.MoreThanOneCell
 MsgBox "More than one cell", vbExclamation
 Case CustomError.UnknownGetDouble
 MsgBox "Unknown error in GetDoubleFromVariant", vbExclamation
 Case CustomError.NoneBelowCap
 MsgBox "No values below cap", vbExclamation
 Case Else
 MsgBox "Unexpected Error: " & Err.Number & "- " & Err.Description, vbCritical
 End Select
End Sub

In this example, all the errors are message box errors, but that may not be completely applicable to your situation here.

Now you can move all the error handling out of the main functions

On Error GoTo CleanFail:
If min >= threshold Then Err.Raise CustomError.NoneBelowCap
CleanExit:
 Exit Sub
CleanFail:
 CustomErrorHandler Err
 Resume CleanExit

You can consolidate all those different error handlers into one main handler using your new error function and enum. And you won't need to remember what error number is what error.

---

Your arguments being able to be brought up with Ctrl +Shift+ a is about the best you can do for tooltips, but a lot of users don't know about that AND it has to be erased. So that's totally up to you. I like the idea of closely matching default argument parameters when creating a UDF close to a built-in function.

• Greedo: Good point on moving those magic error numbers elsewhere. I think it's worth noting though that a message box error is probably not the best way of handling it in this case. Imagine running this function in multiple cells and getting a hundred message boxes! OP's approach of catching errors and converting to excel error codes is good from a UI perspective I think. (NB, I appreciate you probably don't mean to have your code suggestion implemented verbatim, but maybe alter the wording of your first paragraph to that effect)
• Raystafarian: Good bump community, thanks @Greedo - very good point