I made the following function from code in John Walkenbach's Excel
2003 Power Programming with VBA.
The problem I am having is when I use this function with an array
formula it returns a #VALUE! error. I've copied the formula below its
a little complex but the jest is that it tests if a few conditions are
true then returns an array of numbers.
=maxabs(((((Calculation!$G$87="Governing")+(Calculation!$G
$87=Risa_D))*((Calculation!$F$87="Governing")+(Calculation!$F
$87=N(OFFSET(INDIRECT("'Risa Import'!$B$1"),ROW(Risa_D)-Risa_D,
0))))*((Calculation!$E$87="Governing")+(Calculation!$E
$87=T(OFFSET(INDIRECT("'Risa Import'!$C$1"),ROW(Risa_D)-Risa_D,
0))))*(ROW(Risa_D)))>0)*Risa_J)*on
Risa_D is a named range that equals something like indirect("Range")
where "Range" is located on another sheet.
Function MaxAbs(ParamArray args() As Variant) As Variant
' Variable declarations
Dim i As Variant
Dim TempRange As Range, cell As Range
Dim ECode As String
MaxAbs = 0
' Process each argument
For i = LBound(args) To UBound(args)
' Skip missing arguments
If Not IsMissing(args(i)) Then
' What type of argument is it?
Select Case TypeName(args(i))
Case "Range"
' Create temp range to handle full row or column ranges
Set TempRange = Intersect(args(i).Parent.UsedRange, args(i))
For Each cell In TempRange
Select Case TypeName(cell.Value)
Case "Double"
If Abs(cell.Value) > Abs(MaxAbs) Then _
MaxAbs = cell.Value
Case "String"
'MySum = MySum + Evaluate(cell.Value)
Case "Error"
Select Case cell.Text
Case "#DIV/0!"
MaxAbs = CVErr(xlErrDiv0)
Case "#N/A"
MaxAbs = CVErr(xlErrNA)
Case "#NAME?"
MaxAbs = CVErr(xlErrName)
Case "#NULL!"
MaxAbs = CVErr(xlErrNull)
Case "#NUM!"
MaxAbs = CVErr(xlErrNum)
Case "#REF!"
MaxAbs = CVErr(xlErrRef)
Case "#VALUE!"
MaxAbs = CVErr(xlErrValue)
End Select
Exit Function
Case "Date"
If Abs(cell.Value) > Abs(MaxAbs) Then _
MaxAbs = cell.Value
Case "Empty"
Case "Boolean"
If cell.Value = "True" Then _
If 1 > Abs(MaxAbs) Then _
MaxAbs = 1
Case Else
If Abs(args(i)) > Abs(MaxAbs) Then _
MaxAbs = args(i)
End Select
Next cell
Case "Null" 'ignore it
Case "Error" 'return the error
MaxAbs = args(i)
Exit Function
Case "Boolean"
' Check for literal TRUE and compensate
If args(i) = "True" Then _
If 1 > Abs(MaxAbs) Then _
MaxAbs = 1
Case "Date"
If Abs(args(i)) > Abs(MaxAbs) Then _
MaxAbs = args(i)
Case Else
If Abs(args(i)) > Abs(MaxAbs) Then _
MaxAbs = args(i)
End Select
End If
Next i
End Function
I do have a function that works but it only works for this case and
not for other cases I need this function for.
Function MAXABS(rng)
Dim MaxVal, MinVal
MaxVal = WorksheetFunction.Max(rng)
MinVal = WorksheetFunction.Min(rng)
MAXABS = IIf(MaxVal < Abs(MinVal), MinVal, MaxVal)
End Function
Any help would be great.
|
Similar Threads
