Consulting

Results 1 to 10 of 10

Thread: Solved: Counting colors

  1. #1
    VBAX Regular
    Joined
    Aug 2006
    Posts
    82
    Location

    Solved: Counting colors

    I have been working on this for hours, but I think it's time to turn it over to the experts. I want to write a function that will count the number of times a particular color of cell shading is used in a selected range. Is this doable? Any help is greatly appreciated.

  2. #2
    VBAX Regular
    Joined
    Sep 2007
    Location
    Singapore
    Posts
    63
    I think it's do-able. I'm no expert but this is what I would do:

    [vba]Private Sub CountColor()
    Dim Activerg As Range
    Dim CheckCell As Range
    Dim ColCount As Long

    With ActiveSheet
    'Set the range here to the range you want
    Set Activerg = .Range("A1:A10")

    For Each CheckCell In Activerg
    'Set the ColorIndex to the corresponding colour number you want
    If CheckCell.Interior.ColorIndex = 3 Then
    ColCount = ColCount + 1
    End If
    Next CheckCell
    End With

    MsgBox "Red is used " & ColCount & " times."
    End Sub[/vba]
    I've tried it out and it works fine. For a list of possible ColorIndex numbers, check out this site; it's the first site to appear when I Googled for "excel colours".

  3. #3
    This one is basically the same as herzberg's, but it works as a User Defined Function, useable in formulas:

    [vba]Function CountColor(CountRange As Range, ReferenceCell As Range)
    Dim Cnt As Long, c As Range
    For Each c In CountRange.Cells
    If c.Interior.ColorIndex = ReferenceCell.Interior.ColorIndex Then Cnt = Cnt + 1
    Next
    CountColor = Cnt
    End Function
    [/vba]

    EDIT:
    Unfortunately, changing color of the reference cell does not initiate recalculation of formulas, so maybe it would be better to assign the code to a commandbutton...
    Or to introduce a new parameter, solely for the sole purpose of getting Excel to recalculate. Like this:

    [vba]Function CountColor(CountRange As Range, ReferenceCell As Range, DirtyCell as Range)
    Dim Cnt As Long, c As Range
    For Each c In CountRange.Cells
    If c.Interior.ColorIndex = ReferenceCell.Interior.ColorIndex Then Cnt = Cnt + 1
    Next
    CountColor = Cnt
    End Function
    [/vba]

    If the cell defined as DirtyCell has its value changed, the formula is recalculated.
    -------------------------------------------------
    The more details you give, the easier it is to understand your question. Don't save the effort, tell us twice rather than not at all. The amount of info you give strongly influences the quality of answer, and also how fast you get it.

  4. #4
    VBAX Mentor anandbohra's Avatar
    Joined
    May 2007
    Location
    Mumbai
    Posts
    313
    Location
    here is the function with example

    say u have 90 cells with 43 belongs to color yellow
    now type in any cell =countcolor(cell with color to search, range to search)
    e.g. say a1 is shaded with yellow color & total area belongs to a1:b45
    so your formula will be in cell D1 =countcolor(A1,A1:B45)
    [VBA]
    Function CountColor(rColor As Range, rSumRange As Range)
    Application.Volatile
    Dim rCell As Range
    Dim iCol As Integer
    Dim vResult

    iCol = rColor.Interior.ColorIndex
    For Each rCell In rSumRange
    If rCell.Interior.ColorIndex = iCol Then
    vResult = vResult + 1
    End If
    Next rCell
    CountColor = vResult
    End Function

    [/VBA]
    Always Mark your Thread as Solved the moment u got acceptable reply (located under Thread tools)
    Practice this & save time of others in thinking for unsolved thread

  5. #5
    www.Ozgrid.com VBAX Newbie
    Joined
    Jun 2004
    Posts
    5
    Location
    Now that code looks VERY familar! I could swear that is from Ozgrid.

    About the only difference is the removal of code comments that stated who wrote the code. It's rather sad when someone tries to pass someone elses code as their own, very sad.[quote=anandbohra]here is the function with example
    Quote Originally Posted by anandbohra
    [vba]
    Function CountColor(rColor As Range, rSumRange As Range)
    Application.Volatile
    Dim rCell As Range
    Dim iCol As Integer
    Dim vResult

    iCol = rColor.Interior.ColorIndex
    For Each rCell In rSumRange
    If rCell.Interior.ColorIndex = iCol Then
    vResult = vResult + 1
    End If
    Next rCell
    CountColor = vResult
    End Function

    [/vba]

  6. #6
    VBAX Master TonyJollans's Avatar
    Joined
    May 2004
    Location
    Norfolk, England
    Posts
    2,291
    Location
    I haven't checked but I presume the offered solutions do their stuff. They will only ever provide half the answer, though, as there are other ways to set cell shading colours that are not reflected in the Interior object (for example, CF). Also note that it is significantly more complex in 2007.
    Enjoy,
    Tony

    ---------------------------------------------------------------
    Give a man a fish and he'll eat for a day.
    Teach him how to fish and he'll sit in a boat and drink beer all day.

    I'm (slowly) building my own site: www.WordArticles.com

  7. #7
    VBAX Regular
    Joined
    Aug 2006
    Posts
    82
    Location
    Thanks for all your help! As usual, you've taught me some new things.

  8. #8
    VBAX Mentor anandbohra's Avatar
    Joined
    May 2007
    Location
    Mumbai
    Posts
    313
    Location
    Hi Dave Hawley

    Nice to see you in this forum
    and sir u r absolutely right that this code is of your site OZGRID the site which provides me lots of free excel VBA code like count by color, sum by color etc. etc. i am member of OZGRID also (id smarty_great) & also of other excel site.

    & my mistake that i forgotten this time to mention the reference of the code
    as this is my practise to mention the source name coz i am only collector where as u people are generator

    refer my cross linked post where i mention the source name
    HTML Code:
    http://www.vbaexpress.com/forum/showpost.php?p=113548&postcount=2

    MTNL
    07/08/2007
    146.8
    146.8
    140.5
    142.5
    Always Mark your Thread as Solved the moment u got acceptable reply (located under Thread tools)
    Practice this & save time of others in thinking for unsolved thread

  9. #9
    VBAX Mentor Brandtrock's Avatar
    Joined
    Jun 2004
    Location
    Titonka, IA
    Posts
    399
    Location
    Quote Originally Posted by anandbohra
    Hi Dave Hawley

    Nice to see you in this forum
    and sir u r absolutely right that this code is of your site OZGRID the site which provides me lots of free excel VBA code like count by color, sum by color etc. etc. i am member of OZGRID also (id smarty_great) & also of other excel site.

    & my mistake that i forgotten this time to mention the reference of the code
    as this is my practise to mention the source name coz i am only collector where as u people are generator

    refer my cross linked post where i mention the source name
    HTML Code:
    http://www.vbaexpress.com/forum/showpost.php?p=113548&postcount=2
    MTNL
    07/08/2007
    146.8
    146.8
    140.5
    142.5
    Mayhap you should leave the comments in the code to serve as a polite reminder to yourself as to the origin of the code. Also, if the comments aren't deleted, then including them in the code when posting it as a solution will automatically id the code source for those using it to solve a problem.

    Regards,
    Brandtrock




  10. #10
    www.Ozgrid.com VBAX Newbie
    Joined
    Jun 2004
    Posts
    5
    Location
    & my mistake that i forgotten this time to mention the reference of the code
    Hardly a "mistake" or "forgotten" when you REMOVE the credits.

Posting Permissions

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