PDA

View Full Version : [SOLVED] Counting conditional format colours, column by column



vanhunk
04-15-2014, 06:31 AM
Counting the conditional format colours, column by column:

I have a table with columns representing months and rows some measurement. Each cell in the table are conditionally formatted, using formulas. What I need to do is count all the visible green, all the visible orange, and all the visible red cells per column. I have attached a file that does that for a selection. What I need is for the macro to step through the table, column by column and put the 3 results for each column below it.

This is the code thus far, it does the calculation for a selection only:



Sub SumCountByConditionalFormat()
Dim GreenRefColor As Long
Dim OrangeRefColor As Long
Dim RedRefColor As Long

Dim cntGreen As Long
Dim cntOrange As Long
Dim cntRed As Long

Dim i As Integer

Dim cellCurrent As Range

Dim cntCells As Long

cntGreen = 0
cntOrange = 0
cntRed = 0

i = 0

cntCells = Selection.CountLarge

GreenRefColor = Range("D65").DisplayFormat.Interior.Color
OrangeRefColor = Range("D66").DisplayFormat.Interior.Color
RedRefColor = Range("D67").DisplayFormat.Interior.Color

For i = 1 To (cntCells - 1)

If GreenRefColor = Selection(i).DisplayFormat.Interior.Color Then
cntGreen = cntGreen + 1
End If

If OrangeRefColor = Selection(i).DisplayFormat.Interior.Color Then
cntOrange = cntOrange + 1
End If

If RedRefColor = Selection(i).DisplayFormat.Interior.Color Then
cntRed = cntRed + 1
End If

Next

Range("E65") = cntGreen
Range("E66") = cntOrange
Range("E67") = cntRed


End Sub


I appreciate any help.

Thank you very much!

snb
04-15-2014, 08:10 AM
Just a formula ?
in E65


=($E$7<TODAY())*SUMPRODUCT(N(E7:E62<>D7:D62))-COUNTBLANK(E7:E62)

vanhunk
04-15-2014, 12:02 PM
Hi snb, Thanks. The problem I have is that the conditional formatting are different for the different cells and I also need the figures for the other colours. It would be fantastic if a formula could do the job, but alas. Even the result for the one is incorrect. It returns 17 where the actual "green" count is 19.

snb
04-16-2014, 03:55 AM
Sub M_snb()
ReDim sn(2, 12)
sn(0, 12) = Range("D65").Interior.Color
sn(1, 12) = Range("D66").Interior.Color
sn(2, 12) = Range("D67").Interior.Color

For jj = 5 To 16
For j = 7 To 62
If Cells(j, jj).DisplayFormat.Interior.Color = sn(0, 12) Then sn(0, jj - 5) = sn(0, jj - 5) + 1
If Cells(j, jj).DisplayFormat.Interior.Color = sn(1, 12) Then sn(1, jj - 5) = sn(1, jj - 5) + 1
If Cells(j, jj).DisplayFormat.Interior.Color = sn(2, 12) Then sn(2, jj - 5) = sn(2, jj - 5) + 1
Next
Next

Cells(65, 5).Resize(UBound(sn) + 1, UBound(sn, 2)) = sn
End Sub

or


Sub M_snb()
ReDim sn(2, 12)
c00 = "|" & Range("D65").Interior.Color & "|" & Range("D66").Interior.Color & "|" & Range("D67").Interior.Color & "|"

For jj = 5 To 16
For j = 7 To 62
If InStr(c00, "|" & Cells(j, jj).DisplayFormat.Interior.Color & "|") Then
y = UBound(Split(Left(c00, InStr(c00, "|" & Cells(j, jj).DisplayFormat.Interior.Color & "|")), "|")) - 1
sn(y, jj - 5) = sn(y, jj - 5) + 1
End If
Next
Next

Cells(65, 5).Resize(UBound(sn) + 1, UBound(sn, 2)) = sn
End Sub

vanhunk
04-16-2014, 05:48 AM
Thanks snb,
As always a very concise and compact solution. I really appreciate it.

Regards,
vanhunk

I have also come up with a solution, I am afraid not as compact and to the point as yours, but here it is in any case:


Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Integer

Dim GreenRefColor As Long
Dim OrangeRefColor As Long
Dim RedRefColor As Long

Dim cntGreen As Long
Dim cntOrange As Long
Dim cntRed As Long

GreenRefColor = Range("GreenRef").DisplayFormat.Interior.Color
OrangeRefColor = Range("OrangeRef").DisplayFormat.Interior.Color
RedRefColor = Range("RedRef").DisplayFormat.Interior.Color

i = 0
j = 0

For j = Range("Qtr1S1").Column To Range("Qtr4S3").Column

cntGreen = 0
cntOrange = 0
cntRed = 0

Application.ScreenUpdating = False

For i = Range("Qtr1S1").Row To Range("Qtr1E1").Row

Select Case Cells(i, j).DisplayFormat.Interior.Color
Case GreenRefColor

cntGreen = cntGreen + 1

Case OrangeRefColor

cntOrange = cntOrange + 1

Case RedRefColor

cntRed = cntRed + 1

End Select

Next i

'Application.ScreenUpdating = True

Cells(Range("GreenRef").Row, j) = cntGreen
Cells(Range("OrangeRef").Row, j) = cntOrange
Cells(Range("RedRef").Row, j) = cntRed

Next j

Application.ScreenUpdating = True

End Sub



I have attached a working file.

Thanks again!

snb
04-16-2014, 06:40 AM
You might revise the amount of conditional formats.
It looks as if the worksheet contains 'some' conditional formats too many.