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