Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 8 of 8

Thread: counting "colored" cells

  1. #1
    New Member
    Join Date
    Mar 2002
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  2. #2
    MrExcel MVP
    Colo's Avatar
    Join Date
    Mar 2002
    Location
    Kobe, Japan
    Posts
    1,456
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    2 Thread(s)

    Default

    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 ]

  3. #3
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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 ]

  4. #4
    MrExcel MVP
    Colo's Avatar
    Join Date
    Mar 2002
    Location
    Kobe, Japan
    Posts
    1,456
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    2 Thread(s)

    Default

    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

  5. #5
    MrExcel MVP
    Colo's Avatar
    Join Date
    Mar 2002
    Location
    Kobe, Japan
    Posts
    1,456
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    2 Thread(s)

    Default

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

  6. #6
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  7. #7
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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.

    Kind Regards,
    Ivan F Moala From the City of Sails

  8. #8
    MrExcel MVP
    Colo's Avatar
    Join Date
    Mar 2002
    Location
    Kobe, Japan
    Posts
    1,456
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    2 Thread(s)

    Default

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

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •