Color Counting Function

[trough]

Tried to convert a working subroutine into a function but now it doesn't work. I'm not good with Range variables so I'm sure it's user error. Intent is to have function count the cells in a given range that have the same color as a single specified cell.

Excel 2010
	A	B	C	D
1		6	<-- This should be 3
2		6	<-- This should be 1
3
4
5
Sheet1

Cell Formulas
Range	Formula
B1	=CountColor(A1,B4:D5)
B2	=CountColor(A2,B4:D5)

Function CountColor(rColor As Range, rRange As Range) As Long
    
'rColor is cell with background color of interest
'rRange is range of cells to consider

Dim rMyRng As Range
Dim iBackColor As Long

On Error Resume Next
    
iBackColor = 0
For Each rMyRng In rRange
 If rMyRng.DisplayFormat.Interior.Color = rColor.DisplayFormat.Interior.Color Then
  iBackColor = iBackColor + 1
 End If
Next

CountColor = iBackColor

End Function

 

[Joe4]

Just remove "DisplayFormat." from this line, i.e.
change this:

If rMyRng.DisplayFormat.Interior.Color = rColor.DisplayFormat.Interior.Color Then

to this:

If rMyRng.Interior.Color = rColor.Interior.Color Then

 

[trough]

Thank you. Yes, that works better but does not capture colors from conditional formatting like the subroutine I started with did (see subroutine code below). Again, I'm trying to convert the subroutine into a function.

Sub DisplayFormatCount()
    
Dim Rng As Range
Dim CountRange As Range
Dim ColorRange As Range
Dim xBackColor As Long
Dim xFontColor As Long

On Error Resume Next
    
Set CountRange = Application.Selection
Set CountRange = Application.InputBox("Count Range :", "DisplayFormatCount", CountRange.Address, Type:=8)
Set ColorRange = Application.InputBox("Color Range(single cell):", "DisplayFormatCount", Type:=8)
Set ColorRange = ColorRange.Range("A1")

xBackColor = 0
xFontColor = 0
For Each Rng In CountRange
 If Rng.DisplayFormat.Interior.Color = ColorRange.DisplayFormat.Interior.Color Then
  xBackColor = xBackColor + 1
 End If

 If Rng.DisplayFormat.Font.Color = ColorRange.DisplayFormat.Font.Color Then
  xFontColor = xFontColor + 1
 End If
Next

MsgBox "BackColor is " & xBackColor & Chr(10) & "FontColor is " & xFontColor

End Sub

 

[Joe4]

If the colors are being applied by Conditional Formatting, why not just check for the same condition that Conditional Formatting is using instead of trying to use colors?

 

[Joe4]

Very odd. It seems to work correctly if you call it in a VBA Procedure, like this:

Sub Test()
    MsgBox CountColor(Range("F1"), Range("F3:F6"))
End Sub

But not when used as a Worksheet function like this:
=CountColor(F1,F3:F6)

I did some research, and came across this: http://www.cpearson.com/Excel/CFColors.htm

KuTools also has as Add-In for this: https://www.extendoffice.com/docume...nt-cells-by-color-conditional-formatting.html

Hope that helps.
As you can see, it is usually better/easier if you can work with the conditions as opposed to trying to count the cells colored by Conditional Formatting.

 

[trough]

You are absolutely correct, I could. However, the condition formatting formulas are a bit messing and there are multiple ones. Using the function would be much cleaner and easier to follow for other users if need be.

Any additional help you could provide would be much appreciated.

 

[Joe4]

Any additional help you could provide would be much appreciated.

Look at the two links I provided in my last post and see if you can incorporate anything from those.
Those are from sources that are Excel experts, far more knowledgeable than me.

 

[trough]

Yes it is odd that the DisplayFormatCount subroutine works fine but the function I'm trying does not. I'm looking at Chip Pearson's stuff now. Thanks. It looks promising (his function is quite longer). I did not come across this earlier before I posted to this forum.

 

[Joe4]

Yep, Chip's site is a good thing to bookmark. Lots of good stuff there!

 

[trough]

No dice! Chip's stuff doesn't work with my condition format formulas. So I'm back to figuring out why the DisplayFormatCount subroutine works while my function does not.