counting "colored" cells

[edwinver]

I have a worksheet with two colored cells. Some are Blue and some are red. is it possible to count the red cells.

These cells are "empty" they are only colored.


Sorry my English isn't that good. Hope you know what I mean

 

[Colo]

Hi. Here is a sample I made before.<pre>
Public Clr As String
Sub ColorIndexCount()
Dim ColorCell As Range
Dim i As Integer, cnt As Integer, j As Long
Dim r As Long
Dim k()
Dim id As Integer, flg As Boolean, x As String

r = ActiveSheet.UsedRange.Rows.Count
ReDim k(1, 0)

For j = 1 To r
For Each ColorCell In Range(Cells(j, 1), Cells(j, 256))
id = ColorCell.Interior.ColorIndex
If id<> xlNone Then
For cnt = 0 To UBound(k, 2)
If k(0, cnt) = id Then flg = True: Exit For
Next
If flg = False Then
ReDim Preserve k(1, i)
k(0, i) = id
k(1, i) = k(1, i) + 1
i = i + 1
Else
k(1, cnt) = k(1, cnt) + 1
End If
flg = False
End If
Next
x = x & "-------Row" & j & "--------" & vbLf
If Not IsEmpty(k(0, 0)) Then
For cnt = 0 To UBound(k, 2)
Call WhatColor(k(0, cnt))
x = x & Clr & "(" & k(1, cnt) & ")"
Next
End If
x = x & vbLf
i = 0
Erase k
ReDim k(1, 0)
Next
MsgBox x, , "() is number"
End Sub

Sub WhatColor(xx)
Select Case xx
Case 1: Clr = "Black"
Case 2: Clr = "White"
Case 3: Clr = "Deep red"
Case 4: Clr = "Bright green"
Case 5: Clr = "Blue"
Case 6: Clr = " yellow"
Case 7: Clr = " red"
Case 8: Clr = " light blue"
Case 9: Clr = " pink"
Case 10: Clr = " green"
Case 11: Clr = "deep bluish green"
Case 12: Clr = "deep yellow"
Case 13: Clr = " purple"
Case 14: Clr = " bluish green"
Case 15: Clr = " gray 25%"
Case 16: Clr = " gray"
Case 33: Clr = "sky blue"
Case 34: Clr = "a light light blue"
Case 35: Clr = "light green"
Case 36: Clr = "light yellow"
Case 37: Clr = " pale blue"
Case 38: Clr = " rose"
Case 39: Clr = "deep purple"
Case 40: Clr = " beige"
Case 41: Clr = "light blue"
Case 42: Clr = " AKUA"
Case 43: Clr = " lime"
Case 44: Clr = " gold"
Case 45: Clr = "light orange"
Case 46: Clr = "an orange"
Case 47: Clr = " blue gray"
Case 48: Clr = "42% of gray"
Case 49: Clr = "deep bluish green"
Case 50: Clr = " SHIGURIN"
Case 51: Clr = "deep green"
Case 52: Clr = " olive"
Case 53: Clr = " tea"
Case 54: Clr = "a plum"
Case 55: Clr = "indigo"
Case 56: Clr = "80% of gray"
Case Else: Clr = "unknown"
End Select
End Sub</pre>
This message was edited by Colo on 2002-04-26 00:10

 

[Legacy 98055]

Hi
This procedure will count your red cells and place the number in cell A1...

Sub CountRedCell()
Dim c, RedCnt
For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex = 3 Then _
RedCnt = RedCnt + 1
Next
Range("A1") = RedCnt
End Sub

Tom
This message was edited by TsTom on 2002-04-26 00:14

 

[Colo]

If you want only red(Index=3) then try this code.

<pre>
Sub RedCellsCount()
Dim rng As Range, i As Long
For Each rng In ActiveSheet.UsedRange
If rng.Interior.ColorIndex = 3 Then: i = i + 1
Next
MsgBox i
End Sub
</pre>

 

[Colo]

Sorry Tom.
Almost my reply Is the same as yours.

 

[Legacy 98055]

No apology neccesary...
Thanks for the sample code.
I will use it!
I sent you a message a few minutes ago.
Did you read it???
Thanks,
Tom

 

[Ivan F Moala]

Here are a couple of UDF that you may
want to use in your worksheet.

OPTION1:
Counts a User selected range with the colour
code you input.
eg =CountColorCode(C5:C12,3)
Counts the Reds in c5:c15


<pre/>
Function CountColorCode(Range As Range, CCode As Double) As Double
Dim YourDataRange As Range
Dim kount As Double
Dim cell As Range

Application.Volatile

Set YourDataRange = Intersect(Range.Parent.UsedRange, Range)
kount = 0
For Each cell In YourDataRange
If cell.Interior.ColorIndex = CCode Then kount = kount + 1
Next cell
CountColorCode = kount
End Function
</pre>

OPTION2:
Counts the range of colours based on the colour code of Range B13
=CountByColor(D1:D13,$B$13)

<pre/>
Function CountByColor(InputRange As Range, ColorRange As Range) As Double
Dim cl As Range, TempCount As Double, ColorIndex As Integer
Application.Volatile

ColorIndex = ColorRange.Cells(1, 1).Font.ColorIndex
TempCount = 0
On Error Resume Next
For Each cl In InputRange.Cells
If cl.Value <> "" And cl.Font.ColorIndex = ColorIndex Then TempCount = TempCount + 1
Next cl
On Error GoTo 0

Set cl = Nothing

CountByColor = TempCount

End Function

</pre>


Post if unsure.....Note to get a list of
colour codes have a look @ Colos Code.

 

[Colo]

Hi Tom! I've read it and replied.
Thanks,