Excel module - VBA: Function to count colored cells, if condition is met

Question

people!

I do not often refer to VBA in Excel, but when I do, I find answer by Googling. However, there is no answer for my current need.

I have following function to count colours in range (possible source - http://www.ozgrid.com/VBA/sum-count-cells-by-color.htm):

    Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)

    Dim rCell As Range
    Dim lCol As Long
    Dim vResult

    lCol = rColor.Interior.Color


    If SUM = True Then
        For Each rCell In rRange
            If rCell.Interior.Color = lCol Then
                vResult = WorksheetFunction.SUM(rCell)
            End If
        Next rCell
    Else
        For Each rCell In rRange
            If rCell.Interior.Color = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
    End If

    ColorFunction = vResult
End Function

I have tried to extend it to count colours in specific range, if condition is met, but failed.

I ask you, dear colleagues, to help me to extend the function to fulfill the need:

count number of colours in specific range, if word "foo" is met in another range.

Answer 1

Thanks to Shai Rado's solution I could modify the script so that it takes two ranges: 1st for desired colored cell, 2nd for desired word. The script is:

    Function ConditionalColorFunction(rColor As Range, rColoredRange As Range, StrCond As String, rCondRange As Range) As Long

    Dim rColoredCell As Range
    Dim lCol As Long
    Dim i As Integer
    Dim iCondRangeColumnsAmount As Integer
    Dim vResult

    lCol = rColor.Interior.Color
    iCondRangeColumnsAmount = rCondRange.Columns.Count

    For Each rColoredCell In rColoredRange
        If rColoredCell.Interior.Color = lCol Then
           For i = 1 To iCondRangeColumnsAmount
               If Cells(rColoredCell.Row, i).Value = StrCond Then
                   vResult = 1 + vResult
                   Exit For
               End If
           Next
        End If
    Next rColoredCell

    ConditionalColorFunction = vResult
End Function

rColor - cell with desired color.

rColoredRange - range with cells with different colours.

StrCond - desired word.

rCondRange - range with cells with different words.

Answer 2

According to your post, you want to Count the number of coloured cells, so I made the modifiactions below to your Function to work as you posted.

StrCond is the third parameter, which is Optional to check also for a certain String in the rCell.Value.

Function ColorFunction(rColor As Range, rRange As Range, Optional StrCond As String) As Long

    Dim rCell As Range
    Dim lCol As Long
    Dim vResult As Long

    lCol = rColor.Interior.color

    For Each rCell In rRange
        If rCell.Interior.color = lCol Then
            If StrCond <> "" Then
                If rCell.Value = StrCond Then
                    vResult = vResult + 1
                End If
            Else
                vResult = vResult + 1
            End If
        End If
    Next rCell

    ColorFunction = vResult
End Function

Screen-shot of cell's value after testing this Function:

Screen-shot of cell's value after testing this Function without the 3rd parameter (getting 5 as expected):

Answer 3

Lets start with something like this:

Option Explicit

Function ColorFunction(rColor As Range, rRange As Range) As Long

    Dim rCell       As Range
    Dim lCol        As Long
    Dim bFooMet     As Boolean
    Dim lResult     As Long

    lCol = rColor.Interior.Color

    For Each rCell In rRange
        If rCell.Interior.Color = lCol Then lResult = lResult + 1
        If rCell.value = "foo" Then bFooMet = True
    Next rCell

    If bFooMet Then
        ColorFunction = lResult
    Else
        ColorFunction = -1
    End If

End Function

If you activesheet looks like this:

and you write in the immediate window?ColorFunction(cells(1,1),selection) in the immediate window you would get 11 as a result - the number of cells in yellow, with the same background as A1.

If you do not have foo in the selected range, you would get -1.

If you want to count only the yellow cells with foo inside, it could be like this:

Option Explicit

Function ColorFunction(rColor As Range, rRange As Range) As Long

    Dim rCell       As Range
    Dim lCol        As Long
    Dim bFooMet     As Boolean
    Dim lResult     As Long

    lCol = rColor.Interior.Color

    For Each rCell In rRange
        If rCell.value = "foo" And rCell.Interior.Color = lCol Then
            lResult = lResult + 1
        End If
    Next rCell

    ColorFunction = lResult

End Function