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
CombineParametersAsVariantschecks for non-numeric inputs (it has to check types anyway, as that determines whether to useSetor 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
Variantfollowed by aParamArray. This means that the tooltip (by pressingCtrl+Shift+Aafter entering=MAXLESSTHANX(in excel) producesX,number1,number2,...which looks similar to the tooltip for Excel’sMax. Is that overkill – should I just use theParamArray?
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 
