Countif colored cells UDF

[YasserKhalil]

Hello everyone
I have range ("B7:AP8") in the row 8 there are numbers 4 to 0 and in row 7 there are some cells colored in red
I need UDF (not any other way) to count if there are any colored red cells for each number
I imagine
=myFunction(B8:AP8,AR7,B7:AP7,vbRed)
Thanks advanced for help

[Rudi]

Try this...
(Sample workbook attached)

Note: If you change the colour in the color cell, the formula will not update unless you force a recalculate. Making the formula volatile will recalculate if any edit takes place on the sheet, but has its drawbacks too that it recalculates each time a sheet change happens.)
Another caveat: The size of the catrange and the colrange must be the same! I have not added a handle in the code to check this!

Code: Select all

Function CountCatColor(catrange As Range, colrange As Range, criteria As Range, color As Range) As Long
Dim i As Long
Dim lcol As Long
Dim x As Long
    'Application.Volatile
    lcol = color.Interior.ColorIndex
    For i = 1 To catrange.Cells.Count
        If catrange.Cells(i).Value = criteria.Value Then
            If colrange.Cells(i).Interior.ColorIndex = lcol Then
                x = x + 1
            End If
        End If
    Next i
    CountCatColor = x
End Function

Test.xlsm

[Rudi]

I made a small change in the UDF.
If you have already copied it, please replace with the version above...including the option of Volatile.

[YasserKhalil]

That's wonderful and awesome Mr. Rudi
Exactly as I needed
Thank you very much for awesome help

[Rudi]

This version is better as it checks the range dimensions for uniformity.

Code: Select all

Function CountCatColor(catrange As Range, colrange As Range, criteria As Range, color As Range) As Variant
Dim i As Long, lcol As Long, x As Long
    'Application.Volatile ' << Uncomment if recalc must happen dynamically
    If catrange.Cells.Count <> colrange.Cells.Count Then
        CountCatColor = CVErr(xlErrRef)
        Exit Function
    End If
    lcol = color.Interior.ColorIndex
    For i = 1 To catrange.Cells.Count
        If catrange.Cells(i).Value = criteria.Value Then
            If colrange.Cells(i).Interior.ColorIndex = lcol Then
                x = x + 1
            End If
        End If
    Next i
    CountCatColor = x
End Function

[YasserKhalil]

Thank you very much for developing it
In fact the two ranges will be identical in count.cells but it is very great to implement the possible error that may happen
Thanks a lot Mr. Rudi