Is There a Way to count Cell Background Color under Each Column Without Filtering

[andyka]

Hi Experts
Is there a way to count How many Cells are Green, Amber and Blue above each Column without filtering the Data.
Please ignore Dates as some will not have dates. I just want to count the colors above each column.
Having VBA is ok However, formula would be better if possible

Gantt with dates.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	KEY	Not Started			1	2	1
2		InProgress			2	5	5	4	4	4	4	3	2	1	1	1
3		Completed			2	2	2
4	Activity Name	Start	Finish	Activity Status	Oct-21	Nov-21	Dec-21	Jan-22	Feb-22	Mar-22	Apr-22	May-22	Jun-22	Jul-22	Aug-22	Sep-22	Oct-22	Nov-22
5	29-Oct-21
6	10670.5.11 OST - P1
7	SG 0 - TRA (10%)	02/10/21	29/11/21	Not Started	02/10/21	29/11/21
8	Stage Gate 0 Complete		29/11/21	InProgress		29/11/21
9	Start Definition Phase	12/10/21		Completed	12/10/21
10	10670.5.12 OST - P2
11	SG 0 - TRA (10%)	14/10/21	29/12/21	InProgress	14/10/21		29/12/21
12	Stage Gate 0 Complete		29/11/21	Not Started		29/11/21
13	Stage Gate 1 Approved		29/12/21	Not Started			29/12/21
14	Summary - Concept (Planning Package)	22/12/21	20/02/22	Not Started			22/12/21		20/02/22
15	SG0 to SG1 LOE	18/11/21	15/04/22	Not Started		18/11/21					15/04/22
16	10670.5.15 OST - 07
17	Receive Expression of Interest from AWE Sponsor	29/10/21		Completed	29/10/21
18	Start	18/12/21		Completed			18/12/21
19	02-Nov-21
20	10670.5.12 OST - P2
21	Update Risk Register	14/11/21	02/09/22	Not Started		14/11/21										02/09/22
22	Update MDAL	28/03/22	02/05/22	Not Started						28/03/22		02/05/22
23	04-Nov-21
24	10670.5.12 OST - P2
25	Risk Register Review	23/10/21	04/06/22	Not Started	23/10/21								04/06/22
26
27
Sheet1 (2)

Cell Formulas
Range	Formula
E5:R25	E5	=IFERROR(IFS(DATE(YEAR($B5),MONTH($B5),1)=E$4,$B5,DATE(YEAR($C5),MONTH($C5),1)=E$4,$C5),"")

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E5:R25	Expression	=AND($D5=$B$2,IFS(AND($B5<>"",$C5<>""),AND(E$4>=DATE(YEAR($B5),MONTH($B5),1),E$4<=DATE(YEAR($C5),MONTH($C5),1)),AND($B5="",$C5=""),"",OR($B5="",$C5=""),IF(DATE(YEAR(MAX($B5,$C5)),MONTH(MAX($B5,$C5)),DAY(1))=E$4,TRUE)))	text	NO
E5:R25	Expression	=AND($D5=$B$3,IFS(AND($B5<>"",$C5<>""),AND(E$4>=DATE(YEAR($B5),MONTH($B5),1),E$4<=DATE(YEAR($C5),MONTH($C5),1)),AND($B5="",$C5=""),"",OR($B5="",$C5=""),IF(DATE(YEAR(MAX($B5,$C5)),MONTH(MAX($B5,$C5)),DAY(1))=E$4,TRUE)))	text	NO
E5:R25	Expression	=AND($D5=$B$1,IFS(AND($B5<>"",$C5<>""),AND(E$4>=DATE(YEAR($B5),MONTH($B5),1),E$4<=DATE(YEAR($C5),MONTH($C5),1)),AND($B5="",$C5=""),"",OR($B5="",$C5=""),IF(DATE(YEAR(MAX($B5,$C5)),MONTH(MAX($B5,$C5)),DAY(1))=E$4,TRUE)))	text	NO

 

[andyka]

I have given you no version of anything. If you can't straighten out who is replying here then unfortunately I will have to bow out.
In that post, I merely pointed out what was different without giving you what I think is the right function call since it's not my code and I don't want to cut in on someone else's advice here. Besides, you were given the correct call in post 14.

Thank you for your help. I will keep looking for answer

 

[offthelip]

I took the worksheet you posted in post 16 and pasted it into a blank worksheet , ( at that point I get #Name error), I then copied the code I posted in post 11 and posted it into a standard module in the same workbook, I then forced a recalcualtion by typing Function key 2 and retun and I get the picture below,, so it works perfectly. So you must have done something wrong in copying the macro into the workbook. Have a look at this guide on how to insert a macro into a workbook. Note you need to put this in a MODULE ( not the sheet) i.e step 6.
Install a Macro into an Excel Spreadsheet - TeachExcel.com
Note you select the range you want the function to work over just like any other excel function, it operates just like Average() or Count() , it is a User defined Function a brilliant excel feature. It means one can create any function you want. ( and I do!!)

 

[andyka]

Hi Micron
I got the code working but its not yours. However. One thing I forgot to tell you that all the colors in Column E:AR are conditional formatted.
But using the code below only works for E1 which means I have to paste the code for each column and cell.
Is there way to do it automatically for E1:E3 for range E5:50 and F1;F3 for range F5:50 so and s. since you're an expert in VBA. I really need help with this if you don't mind helping please.

Public Sub CountColorCells()
'Variable declaration
Dim rng As Range
Dim lColorCounter As Long
Dim rngCell As Range
'Set the range
Set rng = Sheet2.Range("E5:E25")
'loop throught each cell in the range
For Each rngCell In rng
'Checking Yellor color
If Cells(rngCell.Row, rngCell.Column).DisplayFormat.Interior.Color = RGB(0, 176, 240) Then
lColorCounter = lColorCounter + 1
End If
Next
'Display the value in cell A12
Sheet2.Range("E1") = lColorCounter
End Sub

 

[offthelip]

One thing I forgot to tell you that all the colors in Column E:AR are conditional formatted.

That changes everything!! My code is designed for detecting colors done by formatting NOt conditional formatting. If you have got conditional formatting just put the same equation in to the cells at the top.
You do seem to get confused as to who you are communicating with .. I am dropping out of this conversation since my code is not what you.
Bye! (from Offthelip)

 

[Micron]

Hi Micron
I tried your version to but same answer. "ZERO"

To be fair, that was shown in post 1, no? Up to now I haven't worried about it as I was trying certain techniques (many of which have proved to be exasperating). At the moment, trying to find out why I can't set a cell to a color
( rng.Interior.ColorIndex = [number here] )
when I have Function countColors(rng As Range) As Variant

I realize the posted code would probably work for me if I set it up correctly, but I'm stubborn! Besides, I was trying to make it flexible (getting last row with data and using that; allowing for if user changed the status color (C1 to C3) and so on.

One thing that certainly would help is if the colors lined up in the same row. These don't

 

[Micron]

This is where I'm at (and stuck - see notes)

Function countColors(rng As Range) As Long
Dim i As Integer
Dim Lrow As Long, lngClrIndex As Long
'colorindex: 44=orange; 43=green; 33=blue

On Error GoTo errHandler
lngClrIndex = rng.Offset(0, -2).Interior.ColorIndex

Application.EnableEvents = False
With ActiveSheet
    lngClrIndex = .Cells(rng.Row, 3).Interior.ColorIndex
    Lrow = .Cells(Rows.count, "A").End(xlUp).Row
    For i = 5 To Lrow
        If .Cells(i, rng.Column).Interior.ColorIndex <> -4142 Then
            If .Cells(i, rng.Column).Interior.ColorIndex = lngClrIndex Then
                countColors = countColors + 1
            End If
        End If
    Next
    If countColors = 0 Then
        'rng.Interior.ColorIndex = -4142  'ANY attempt so far to set cells with 0 to no color raises error (1004 application defined or object defined error)
    Else
        '.Cells(rng.Row, rng.Column).Interior.ColorIndex = lngClrIndex  'ditto, whether using rng, .Cells, etc.
    End If
End With

exitHere:
Application.EnableEvents = True
Exit Function

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Function

I have this in E1, E2 and E3 respectively:
=countcolors(E1)
=countcolors(E2)
=countcolors(E3)
and copied the formats from C to E

so that the colors line up.
End result is that I get the right values, but I cannot set 0 to no color (-4142).

Dragging the formula drags the colors as well (by default - I realize that's an option) but was trying to make it automatic and clear color for zeros.
Other than dynamically getting the last row with data, it's not much different than the code you already have.
BTW, CF rules are not an issue since those are in the body of data and not where the code is. .ColorIndex seems to handle that just fine.
Being stubborn, I will probably continue to try and find out why I can't set the index. Tried every applicable Google result and no dice. They're all pretty much the same anyway.

 

[Fluff]

How about

Function CountByColor(Rng As Range, Clr As Range) As Long
   Dim TotalC As Long, ClrVal As Long
   Dim Cl As Range
   
   ClrVal = Evaluate("getcfcolour(" & Clr.Address(, , , 1) & ")")
   
   For Each Cl In Rng
      If Evaluate("getcfcolour(" & Cl.Address(, , , 1) & ")") = ClrVal Then
         TotalC = TotalC + 1
      End If
   Next Cl
   CountByColor = TotalC
End Function
Function GetCFColour(Cl As Range) As Long
   GetCFColour = Cl.DisplayFormat.Interior.Color
End Function

Used like

=CountByColor(E5:E25,$C2)

 

[Peter_SSs]

I think that this should be possible using formulas (as you wished) by using the same sort of conditions that you have used to colour the cells with the Conditional Formatting** in the first place. I am not sure that I have this completely right but it is producing the expected results shown in post #4 apart from the green count. However, I cannot see the logic for the green expected results in that sample so I am hoping that they are incorrect and the correct results are here (& also shown in post #15).

22 11 27.xlsm
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	Not Started			2	5	5	4	4	4	4	3	2	1	1	1
2	InProgress			1	2	1	0	0	0	0	0	0	0	0	0
3	Completed			2	0	1	0	0	0	0	0	0	0	0	0
4	Start	Finish	Activity Status	Oct-21	Nov-21	Dec-21	Jan-22	Feb-22	Mar-22	Apr-22	May-22	Jun-22	Jul-22	Aug-22	Sep-22
5
6
7	02/10/21	29/11/21	Not Started	02/10/21	29/11/21
8		29/11/21	InProgress		29/11/21
9	12/10/21		Completed	12/10/21
10
11	14/10/21	29/12/21	InProgress	14/10/21		29/12/21
12		29/11/21	Not Started		29/11/21
13		29/12/21	Not Started			29/12/21
14	22/12/21	20/02/22	Not Started			22/12/21		20/02/22
15	18/11/21	15/04/22	Not Started		18/11/21					15/04/22
16
17	29/10/21		Completed	29/10/21
18	18/12/21		Completed			18/12/21
19
20
21	14/11/21	02/09/22	Not Started		14/11/21										02/09/22
22	28/03/22	02/05/22	Not Started						28/03/22		02/05/22
23
24
25	23/10/21	04/06/22	Not Started	23/10/21								04/06/22
Count

Cell Formulas
Range	Formula
E1:P2	E1	=SUMPRODUCT(--($D$5:$D$25=$B1),($B$5:$B$25<>"")*($C$5:$C$25<>"")*($B$5:$B$25-DAY($B$5:$B$25)+1<=E$4)*($C$5:$C$25-DAY($C$5:$C$25)+1>=E$4)+(($B$5:$B$25<>"")+($C$5:$C$25<>"")=1)*($B$5:$B$25+$C$5:$C$25-DAY($B$5:$B$25+$C$5:$C$25)+1=E$4))
E3:P3	E3	=SUMPRODUCT(--($D$5:$D$25=$B3),($B$5:$B$25<>"")*($C$5:$C$25<>"")*($B$5:$B$25-DAY($B$5:$B$25)+1=E$4)+(($B$5:$B$25<>"")+($C$5:$C$25<>"")=1)*($B$5:$B$25+$C$5:$C$25-DAY($B$5:$B$25+$C$5:$C$25)+1=E$4))
E5:P25	E5	=IFERROR(IFS(DATE(YEAR($B5),MONTH($B5),1)=E$4,$B5,DATE(YEAR($C5),MONTH($C5),1)=E$4,$C5),"")

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E5:R25,T5:V25	Expression	=AND($D5=$B$3,IFS(AND($B5<>"",$C5<>""),AND(E$4>=DATE(YEAR($B5),MONTH($B5),1),E$4<=DATE(YEAR($C5),MONTH($C5),1)),AND($B5="",$C5=""),0,OR($B5="",$C5=""),IF(DATE(YEAR(MAX($B5,$C5)),MONTH(MAX($B5,$C5)),DAY(1))=E$4,TRUE)))	text	NO
E5:R25,T5:V25	Expression	=AND($D5=$B$2,IFS(AND($B5<>"",$C5<>""),AND(E$4>=DATE(YEAR($B5),MONTH($B5),1),E$4<=DATE(YEAR($C5),MONTH($C5),1)),AND($B5="",$C5=""),0,OR($B5="",$C5=""),IF(DATE(YEAR(MAX($B5,$C5)),MONTH(MAX($B5,$C5)),DAY(1))=E$4,TRUE)))	text	NO
E5:R25,T5:V25	Expression	=AND($D5=$B$1,IFS(AND($B5<>"",$C5<>""),AND(E$4>=DATE(YEAR($B5),MONTH($B5),1),E$4<=DATE(YEAR($C5),MONTH($C5),1)),AND($B5="",$C5=""),0,OR($B5="",$C5=""),IF(DATE(YEAR(MAX($B5,$C5)),MONTH(MAX($B5,$C5)),DAY(1))=E$4,TRUE)))	text	NO

** Regarding your Condition Formatting formulas
I am not sure that you have them right. For example, with your current CF formulas, if you enter 'Not Started' in cell D23 and leave B23 and C23 blank, the whole row turns blue and I am assuming that is not correct?
In my sample above, I have slightly altered your CF formulas to prevent that happening.