# Robust UDF for finding the max less than a threshold

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


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.

• 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) – Greedo Dec 17 '18 at 11:30
• Good bump community, thanks @Greedo - very good point – Raystafarian Dec 18 '18 at 7:43