Min/MaxifbyColor

[quin]

I have this Function I found at Chip Pearson's site for SumIfByColor.
how would one modify it to be a MaxIfByColor or MinIfByColor?
I thought it would be as easy as replacing sum with min/max but i was mistaken.

here is the code:

Function SumIfByColor(InRange As Range, _
    WhatColorIndex As Integer, SumRange As Range, _
    Optional OfText As Boolean = False) As Variant
'
' This function will return the SUM of the values of cells in
' SumRange where the corresponding cell in InRange has a background
' color (or font color, if OfText is true) equal to WhatColorIndex.
'
Dim OK As Boolean
Dim Ndx As Long

Application.Volatile True

If (InRange.Rows.Count <> SumRange.Rows.Count) Or _
    (InRange.Columns.Count <> SumRange.Columns.Count) Then
    SumIfByColor = CVErr(xlErrRef)
    Exit Function
End If

For Ndx = 1 To InRange.Cells.Count
    If OfText = True Then
        OK = (InRange.Cells(Ndx).Font.ColorIndex = WhatColorIndex)
    Else
        OK = (InRange.Cells(Ndx).Interior.ColorIndex = WhatColorIndex)
    End If
    If OK And IsNumeric(SumRange.Cells(Ndx).Value) Then
        SumIfByColor = SumIfByColor + SumRange.Cells(Ndx).Value
    End If
Next Ndx

End Function

thanks

quincy

 

[Scott Huish]

Perhaps:

Function MaxIfByColor(InRange As Range, _
    WhatColorIndex As Integer, MaxRange As Range, _
    Optional OfText As Boolean = False) As Variant
'
' This function will return the MAX of the values of cells in
' MaxRange where the corresponding cell in InRange has a background
' color (or font color, if OfText is true) equal to WhatColorIndex.
'
Dim OK As Boolean
Dim Ndx As Long
Dim j

Application.Volatile True

If (InRange.Rows.Count <> MaxRange.Rows.Count) Or _
    (InRange.Columns.Count <> MaxRange.Columns.Count) Then
    MaxIfByColor = CVErr(xlErrRef)
    Exit Function
End If

For Ndx = 1 To InRange.Cells.Count
    If OfText = True Then
        OK = (InRange.Cells(Ndx).Font.ColorIndex = WhatColorIndex)
    Else
        OK = (InRange.Cells(Ndx).Interior.ColorIndex = WhatColorIndex)
    End If
    If OK And IsNumeric(MaxRange.Cells(Ndx)) Then
        If IsEmpty(j) Then
            j = MaxRange.Cells(Ndx)
        Else
            If MaxRange.Cells(Ndx) > j Then _
                j = MaxRange.Cells(Ndx)
        End If
    End If
Next Ndx
MaxIfByColor = j
End Function

Function MinIfByColor(InRange As Range, _
    WhatColorIndex As Integer, MinRange As Range, _
    Optional OfText As Boolean = False) As Variant
'
' This function will return the MIN of the values of cells in
' MinRange where the corresponding cell in InRange has a background
' color (or font color, if OfText is true) equal to WhatColorIndex.
'
Dim OK As Boolean
Dim Ndx As Long
Dim j

Application.Volatile True

If (InRange.Rows.Count <> MinRange.Rows.Count) Or _
    (InRange.Columns.Count <> MinRange.Columns.Count) Then
    MinIfByColor = CVErr(xlErrRef)
    Exit Function
End If

For Ndx = 1 To InRange.Cells.Count
    If OfText = True Then
        OK = (InRange.Cells(Ndx).Font.ColorIndex = WhatColorIndex)
    Else
        OK = (InRange.Cells(Ndx).Interior.ColorIndex = WhatColorIndex)
    End If
    If OK And IsNumeric(MinRange.Cells(Ndx)) Then
        If IsEmpty(j) Then
            j = MinRange.Cells(Ndx)
        Else
            If MinRange.Cells(Ndx) < j Then _
                j = MinRange.Cells(Ndx)
        End If
    End If
Next Ndx
MinIfByColor = j
End Function