absolute maximum with sign
 

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")+(Calcul ation!$G
$87=Risa_D))*((Calculation!$F$87="Governing")+(Cal culation!$F
$87=N(OFFSET(INDIRECT("'Risa Import'!$B$1"),ROW(Risa_D)-Risa_D,
0))))*((Calculation!$E$87="Governing")+(Calculatio n!$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.

absolute maximum with sign
 

You probably are passing the function bad data. I would add a break point in
the vba code at the first execuatable line MaxAbs = 0 and look at the array
args.

1) click on line MaxAbs = 0. Press F9
2) go to excel worksheet and click on cell with the call to maxabs.
3) In the function box (fx) at top of worksheet go to end of function and
press return on keyboard. The program should stop at the breakpoint MaxAbs =
0
4) Go to function lkine in VBA and highlight : args .then right click
and select ADD TO WATCH.
5) In watch window in VBA press plus sigh (+) to expand the variables.
Check to see that all the args contain numbers.

"lukecs" wrote:

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")+(Calcul ation!$G
$87=Risa_D))*((Calculation!$F$87="Governing")+(Cal culation!$F
$87=N(OFFSET(INDIRECT("'Risa Import'!$B$1"),ROW(Risa_D)-Risa_D,
0))))*((Calculation!$E$87="Governing")+(Calculatio n!$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.