Formula to count a column based on color, but ignore blank with same color

[RyOlson]

Goal:
I found this in searching for a formula that could count shaded cells based on their color and it worked great, but if I merge cells it will apply the cell color to them and thus throw off my count. How can I count the cell if its yellow, but ignore if its yellow and blank? I am using VBA and Excel 2016. Thank you for any help provided.

Appearance:

Module:
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.ColorIndex
If SUM = True Then
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = WorksheetFunction.SUM(rCell, vResult)
End If
Next rCell
Else
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = 1 + vResult
End If
Next rCell
End If
ColorFunction = vResult
End Function

 

[Anthony47]

Try modifying the line If rCell.Interior.ColorIndex = lCol Then to

If rCell.Interior.ColorIndex = lCol and rCell.value <> "" Then

Bye

 

[RyOlson]

Try modifying the line If rCell.Interior.ColorIndex = lCol Then to

If rCell.Interior.ColorIndex = lCol and rCell.value <> "" Then

Bye

I corrected the line within VBA and no change was produced. Does the formula need to be modified?
=ColorFunction(B152,$C$7:$C$150,FALSE)

 

[Joe4]

This is a good example of why merged cells should never be used in Excel - they cause all sorts of issues with things like VBA and sorting.
Most experienced programmers will never use them. They are the probably one of the (if not the) worst feature of Excel and should be avoided whenever possible!

That's not saying that these type of things are impossible in all cases, but they are a whole heck of a lot harder than they should be.

 

[Anthony47]

I corrected the line within VBA and no change was produced. Does the formula need to be modified?

I modified the code and now get, for example, the result you see in the picture
A12:B12 are merged cells.

The code now is (the modifiled portion):

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

Bye

 

[Joe4]

I modified the code and now get, for example, the result you see in the picture
A12:B12 are merged cells.

The code now is (the modifiled portion):

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

Bye

I am not sure if it makes a difference, but judging from the original image posted by the OP, it looks to me like the merge cells are happening down rows (i.e. A2:A4) and probably not across columns (A12:B12).

I haven't taken the time to set up an example like they have (they didn't use XL2BB so I cannot simply copy and paste their example) and try your code, so I don't know if that code will have "vertical" merges instead of "horizontal" merges.

 

[Anthony47]

Hi Joe,
I agree that missing a common testbed make the discussion timewasting

The OP code includes twice the portion If rCell.Interior.ColorIndex = lCol Then; the one to be modified is the second occourrence (the first one maybe modified, but don't impact the calculation); so my guess is that he modified only the first occourrence.
Let's wait for Ryolson comment...

Bye

 

[RyOlson]

That modified portion solved my issue. Thank you for your help.