Count the cells with specific Font color within the range of cell that have a specific background color

[kalinajo]

Hi all,

I want to know how much cell have a blue Font color within the cells that have a green background (and so on, 5 background colors and 5 Font colors).

Exemple: I have 20 cells that have a green background, from those cells how much have a blue Font?

Here are my formulas:

Background color count:

Function ColorCount(SearchRange As Range, colorRange As Range) As Long
Dim cell As Range, a As Range, b As Range, n As Integer

' preload for Union method (will Union with itself in first For loop)
Set b = SearchRange(1).MergeArea(1)

For Each cell In SearchRange
Set a = cell.MergeArea(1)
Set b = Union(a, b)
Next

' a becomes the preload for the next Union; n will be used to exclude
' it from the count if it's not the right color
n = a.Interior.Color = colorRange.Interior.Color

For Each cell In b
If cell.Interior.Color = colorRange.Interior.Color Then
Set a = Union(cell, a)
End If
Next

ColorCount = a.Count - 1 - n

End Function
-------------------------------------

*Please note that I need to use some merged cells in my file (no way out of it) and I need them to count as one cell. This Function seems to work perfectly for that.

Font Color count:

Function FontColorCount(SearchRange As Range, colorRange As Range) As Long
Dim cell As Range, a As Range, b As Range, n As Integer

' preload for Union method (will Union with itself in first For loop)
Set b = SearchRange(1).MergeArea(1)

For Each cell In SearchRange
Set a = cell.MergeArea(1)
Set b = Union(a, b)
Next

' a becomes the preload for the next Union; n will be used to exclude
' it from the count if it's not the right color
n = a.Font.Color = colorRange.Font.Color

For Each cell In b
If cell.Font.Color = colorRange.Font.Color Then
Set a = Union(cell, a)
End If
Next

FontColorCount = a.Count - 1 - n

End Function
---------------------------

I am stuck there! Help! I don't know how to use a function within an other one. Also would I need to use a Find function instead of a count Function ie: =Count Font color = Reference cell, IF(Background color = Reference cell) (Rough idea of what I want to do).

Thank you all for your support!

 

[DanteAmor]

Try this

	A	B	C	D
1			HI	2
2		B2
3		B3
4		B4
5		B5
6		B6
7		B7
8		B8

<tbody>
</tbody>

Formula

Cell Formula D1 =ColorInteriorFontCount(B2:B8,C1) <tbody> </tbody>

<tbody>
</tbody>

Function ColorInteriorFontCount(SearchRange As Range, colorRange As Range) As Long
    Dim cell As Range, a As Range, b As Range, n As Integer
    
    ' preload for Union method (will Union with itself in first For loop)
    Set b = SearchRange(1).MergeArea(1)
    
    For Each cell In SearchRange
        Set a = cell.MergeArea(1)
        Set b = Union(a, b)
    Next
    
    ' a becomes the preload for the next Union; n will be used to exclude
    ' it from the count if it's not the right color
    n = a.Interior.Color = colorRange.Interior.Color
    
    For Each cell In b
        If cell.Interior.Color = colorRange.Interior.Color And _
           cell.Font.Color = colorRange.Font.Color Then
            Set a = Union(cell, a)
        End If
    Next
    
    ColorInteriorFontCount = a.Count - 1 - n


End Function

 

[kalinajo]

Thank you very much! It works perfectly!!

Try this

Function ColorInteriorFontCount(SearchRange As Range, colorRange As Range) As Long
    Dim cell As Range, a As Range, b As Range, n As Integer
    
    ' preload for Union method (will Union with itself in first For loop)
    Set b = SearchRange(1).MergeArea(1)
    
    For Each cell In SearchRange
        Set a = cell.MergeArea(1)
        Set b = Union(a, b)
    Next
    
    ' a becomes the preload for the next Union; n will be used to exclude
    ' it from the count if it's not the right color
    n = a.Interior.Color = colorRange.Interior.Color
    
    For Each cell In b
        If cell.Interior.Color = colorRange.Interior.Color And _
           cell.Font.Color = colorRange.Font.Color Then
            Set a = Union(cell, a)
        End If
    Next
    
    ColorInteriorFontCount = a.Count - 1 - n


End Function

 

[DanteAmor]

I'm glad to help you

 

[harky]

Try this

	A	B	C	D
1			HI	2
2		B2
3		B3
4		B4
5		B5
6		B6
7		B7
8		B8

<tbody>
</tbody>

Formula

Cell Formula D1 =ColorInteriorFontCount(B2:B8,C1) <tbody> </tbody>

<tbody>
</tbody>

Function ColorInteriorFontCount(SearchRange As Range, colorRange As Range) As Long
    Dim cell As Range, a As Range, b As Range, n As Integer
 
    ' preload for Union method (will Union with itself in first For loop)
    Set b = SearchRange(1).MergeArea(1)
 
    For Each cell In SearchRange
        Set a = cell.MergeArea(1)
        Set b = Union(a, b)
    Next
 
    ' a becomes the preload for the next Union; n will be used to exclude
    ' it from the count if it's not the right color
    n = a.Interior.Color = colorRange.Interior.Color
 
    For Each cell In b
        If cell.Interior.Color = colorRange.Interior.Color And _
           cell.Font.Color = colorRange.Font.Color Then
            Set a = Union(cell, a)
        End If
    Next
 
    ColorInteriorFontCount = a.Count - 1 - n


End Function

Hi, i try ur code but i had issue..

the count included A1 . A1 is the font colour i want to trigger.. dont know why is 3.. should be 2

Random_Macro.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	purple	red	green	orange	brown	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18
2	3					P	P	P	B	B	B	B	B	B
Sheet1

Cell Formulas
Range	Formula
A2	A2	=ColorInteriorFontCount(F2:W2,A1)

 

[harky]

Hi. nvm. i found a correct code