• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Sum of row by background color for positive or negative numbers

=ColorFunction(B9,D1:M1,2,-1) ' Minimum of all negatives between D1:M1 that match color in B9


The formula above gives the correct answer except when there is no negative number on the row. Then it gives #####.


I've tried using an IFERROR function or conditional formatting to print in white - both without success.


Is there a solution to get rid of the #####?


Everything else is working as requested.


Thanks Again

Blair
 
[pre]
Code:
Function ColorFunction(rColor As Range, rRange As Range, Optional SUM_MIN As Integer = 0, Optional iSign As Integer = 0)
Dim rCell As Range
Dim lCol As Long
Dim vResult
Dim min_val As Variant
min_val = 1E+16 ' An arbitrary high-value

''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'www.ozgrid.com
'Modified by Hui
'SUM_Min
'0 - Sum cells
'1 - Count
'2 - Minimum
'3 - Maximum
'''''''''''''''''''''''''''''''''''''''
lCol = rColor.Interior.ColorIndex
If SUM_MIN = 0 Then ' Sum cells. = Default Value
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
If iSign = -1 And rCell.Value < 0 Then
vResult = vResult + rCell.Value
ElseIf iSign = 1 And rCell.Value > 0 Then
vResult = vResult + rCell.Value
ElseIf iSign = 0 Then
vResult = vResult + rCell.Value
End If
End If
Next rCell
ElseIf SUM_MIN = 1 Then ' Count cells.
vResult = 0
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
If iSign = -1 And rCell.Value < 0 Then
vResult = vResult + 1
ElseIf iSign = 1 And rCell.Value > 0 Then
vResult = vResult + 1
ElseIf iSign = 0 Then
vResult = vResult + 1
End If
End If
Next rCell
ElseIf SUM_MIN = 2 Then ' extract Minimum
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
If iSign = -1 And rCell.Value < 0 And rCell < min_val Then
min_val = rCell
ElseIf iSign = 1 And rCell.Value >= 0 And rCell < min_val Then
min_val = rCell
ElseIf iSign = 0 And rCell < min_val Then
min_val = rCell
End If
End If
Next rCell
vResult = min_val
If vResult = 1E+16 Then vResult = "Error"

ElseIf SUM_MIN = 3 Then ' extract Maximum
min_val = -min_val
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
If iSign = -1 And rCell.Value < 0 And rCell.Value > min_val Then
min_val = rCell
ElseIf iSign = 1 And rCell.Value >= 0 And rCell > min_val Then
min_val = rCell
ElseIf iSign = 0 And rCell > min_val Then
min_val = rCell
End If
End If
Next rCell
vResult = min_val
If vResult = 1E+16 Then vResult = "Error"

End If
ColorFunction = vResult
End Function
[/pre]
 
Back
Top