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.

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

[ This Message was edited by: Colo on 2002-04-26 00:10 ]

[Tom Schreiner]

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.

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

[Colo]

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

[Tom Schreiner]

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

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

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

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

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,