Countifs with text and interior color criteria

Question

I am trying to create a vba countifs function that has mutliple criteria in different columns. I need it to only count the cells in Column E that have an interior color if the corresponding row in column C has a specific text value.

For instance: Only count cell E10 if C10 has value "TL" and E10 has interior color Green

I am using this VBA code to count the number of interior color cells within a range:

 Function countif_by_color(rl As Range, r2 As Range) As Long

 Application.Volatile
 Dim x As Long
 Dim cel As Range

 x = 0

 For Each cel In rl
     If cel.Interior.color = r2.Interior.color Then
     x = x + 1
     End If
 Next

 countif_by_color = x
 End Function

And I have been trying to use it with this formula ( A13 being the color I want it to count):

 =(COUNTIFS($C$21:$C$101,"=TL",E21:E101,(countif_by_color(E21:E101,A13))))

But this essentially equates the green cells in column E to a number value which changes the countif criteria to counting cells with that numeric value instead of color.

I want to alter the countif_by_color function VBA to have multiple criteria like a countifs function.... thanks in advance!

chris neilsen chris neilsen · Accepted Answer · 2019-02-04T22:33:02

Here's a countifs_by_color UDF that uses a ParameterArray to accept a variable number of ranges. Note: it does not handle Array Formula format, as CountIfS does. If you need that it will require modification.

Function countifs_by_color(ParamArray var() As Variant) As Variant
    Application.Volatile

    Dim criteria_range As Range
    Dim criteria As Range
    Dim cel As Range
    Dim criteria_idx As Long
    Dim critera_rows As Long
    Dim critera_cols As Long
    Dim result_no_match() As Boolean
    Dim criteria_color As Variant
    Dim cell_idx As Long
    Dim match_count As Long

    ' must have even number of parameters
    If ((UBound(var) - LBound(var)) Mod 2) = 0 Then GoTo InvalidParameters

    'capture first range size
    critera_rows = var(LBound(var)).Rows.Count
    critera_cols = var(LBound(var)).Columns.Count

    'must be one row or one column
    If critera_rows <> 1 And critera_cols <> 1 Then GoTo InvalidParameters

    'size array to capture matches
    ReDim result_no_match(1 To IIf(critera_rows > 1, critera_rows, critera_cols)) 'initialises to all False

    For criteria_idx = LBound(var) To UBound(var) Step 2
        Set criteria_range = var(criteria_idx)
        Set criteria = var(criteria_idx + 1)

        'criteria must be single cell
        If criteria.Count <> 1 Then GoTo InvalidParameters

        'all criteria_rane must be same size
        If criteria_range.Rows.Count <> critera_rows Or criteria_range.Columns.Count <> critera_cols Then GoTo InvalidParameters

        'get color of criteria cell to avoid unnecassary sheet references
        criteria_color = criteria.Interior.Color

        'check each cell in criteria_range
        For cell_idx = 1 To criteria_range.Cells.Count
            'if cell has not already been invalidated
            If Not result_no_match(cell_idx) Then
                'compare colors
                If criteria_range.Cells(cell_idx).Interior.Color <> criteria_color Then
                    'no match, invalidate cell
                    result_no_match(cell_idx) = True
                End If
            End If
        Next
    Next

    'count matches
    For cell_idx = LBound(result_no_match) To UBound(result_no_match)
        If Not result_no_match(cell_idx) Then
            match_count = match_count + 1
        End If
    Next

    countifs_by_color = match_count
Exit Function
InvalidParameters:
    countifs_by_color = CVErr(xlErrValue)
End Function

Example application

Countifs with text and interior color criteria

1 Answers