locked
counting font colors in a column to obtain the number of items of that color RRS feed

  • Question

  • I have a column with 400+ data items displayed randomly in four different colors. What is the easiest method to write one statement that will give me a total #items of each color in the column? The colors are manually formatted and each color belongs to or represents one group that I need to know how many of each to make sure the CountA for the entire column matches with the sum of all the separate colors counted? I am using the standard colors from the font group to make things easy. Looked at the examples from exldynamic.com and I keep getting a #Name error.

    Roliver

    Monday, July 23, 2012 10:12 PM

Answers

  • Re "So apparently the cell fontcolor attribute gets retained even if the data value is deleted"

    Indeed, cell formats persist even if the cell is empty. If you want to skip empty cells, ie don't count the font colours of those cells, add this IF check to the loop
            For Each cel In rng
               If Len(cel.Value) > 0 Then
                    ' count the font colours
               End If
          Next

    Peter Thornton

    • Proposed as answer by Mike7952 Wednesday, July 25, 2012 11:34 AM
    • Marked as answer by owl89410 Thursday, July 26, 2012 3:50 PM
    Wednesday, July 25, 2012 9:55 AM
  • Try somehting like this -

    Sub CountFontClrs()
    Dim bFlag As Boolean
    Dim i As Long
    Dim TotClrs As Long, clr As Long
    Dim rng As Range, cel As Range
    Dim rngResults As Range
    ReDim arr(0 To 1, 1 To 100) As Long
            On Error GoTo errH
         Set rng = Range("A1:A800")
         Set rngResults = Range("B1")
            For Each cel In rng
                 clr = cel.Font.Color
                 bFlag = True
                 For i = 1 To TotClrs
                         If clr = arr(0, i) Then
                                 arr(1, i) = arr(1, i) + 1
                                 bFlag = False
                                 Exit For
                         End If
                 Next
                 If bFlag Then
                         TotClrs = TotClrs + 1
    99                        arr(1, TotClrs) = TotClrs
                         arr(0, TotClrs) = clr
                 End If
         Next
            ReDim Preserve arr(0 To 1, 1 To TotClrs)
            For i = 1 To TotClrs
                 rngResults.Cells(i, 1).Value = arr(0, i)
                 rngResults.Cells(i, 1).Font.Color = arr(0, i)
                 rngResults.Cells(i, 2).Value = arr(1, i)
         Next
         Exit Sub
    errH:
         If Erl = 99 And Err.Number = 9 Then
                 ReDim Preserve arr(0 To 1, 1 To UBound(arr, 2) + 100)
                 Resume
         Else
                 MsgBox Err.Description
         End If
    End Sub

    You might want to dump the results in some other way, adapt as required. Obviously change the respective range addresses to suit.

    Peter Thornton

    • Proposed as answer by Mike7952 Wednesday, July 25, 2012 11:35 AM
    • Marked as answer by owl89410 Thursday, July 26, 2012 3:52 PM
    Tuesday, July 24, 2012 11:56 AM
  • This looks like a more elegant solution that I think I need.  It puts the decimal value of each of the four colors it found in the cells below the row (displaying in its color) however and not the total of each color found.  Filtering mentioned above is not what I need as I do not need to view the results because it is counting similar items displayed in one of four colors, I just neet the totals of each color found.  I thought that since I'm using standard colors, some variation of the this function could be edited  =COUNTIF(AH5:AH494,".selection.font.color=vbblue") (THIS DOESN'T GIVE A ERROR BUT IT DOESN'T WORK EITHER) I'm not clear if the names as vbblue, vbgreen, vborange, vbpurple are equivalent to those standard menu colors in the font menu group.(?) I just want different colors to stand out on the page and don't care about their decimal values. If I use say five colors in a column to include black, then I could have five different formulas at the bottom of the column, one to count items in each color, or a combination to display the total of each color in its color as this does. Watching this run I'm curious why the i never gets higher than five, seems like it should increment each time the row number increases?? Further help needed to make this work. TIA.

    Roliver

    • Marked as answer by owl89410 Thursday, July 26, 2012 3:52 PM
    Tuesday, July 24, 2012 4:47 PM
  • The macro can't do what you describe, it should do this:

    - read the font colour of each cell in the range
    - loop through an array of previous matched colours
    - if found increment the total for that colour
    - if not found add the new colour the array and mark it's total found so far as 1

    - when done all the found colour-values (integers between 0-16777215) are dumped in a column, and in cells to the right a count of each of the found colours.
    -For convenience the font in the cell with the colour value is formatted with same.

    (This was only an example of how you might want to return the results, as I said adapt as required)

    The macro only returns whole integer numbers. If decimals are seen that's because the 'result' cells were already formatted to display decimals.

    However, there is a small error in the macro as originally posted, change

    arr(1, TotClrs) = TotClrs
    to
    arr(1, TotClrs) = 1

    Peter Thornton

    • Proposed as answer by Brian Skinn Wednesday, July 25, 2012 1:12 AM
    • Marked as answer by owl89410 Thursday, July 26, 2012 3:51 PM
    Tuesday, July 24, 2012 6:13 PM
  • As far as I know, COUNTIF will only operate on the value of the cells being counted -- the condition you enter as the second argument only has a comparison operator and a value, entered as a string, which could be programmatically determined.

    If you have a column on that same worksheet that you can use as a utility column, try the following.  Add the following macro function to the VB Project:

    Function fontColorIndex(cel As Range) As Long
        fontColorIndex = cel.Font.ColorIndex
    End Function

    In the utility column (say cell AI5, since your colored cells appear to be in column AH and the first data value is in row 5), enter as the formula "=colorIndex(AH5)".  Fill this formula all the way down the range AI5:AI494.  Then, in the location where you want to tabulate the cells counted the various colors, use "=COUNTIF(AH5:AH494,"=##", where you replace ## with one number index out of those of the particular colors you've used.  You'd then need to put this COUNTIF formula in however many more cells you need in order to count all of the colors you're interested in.

    Note that one downside of using this user-defined function is that it will only recalculate automatically if/when the numerical value of the cells being referred to (those in AH) changes.  Formatting changes to the cells do not automatically trigger recalculation, nor does a manual Calculation (F9, or via a menu command).  If you double-click the cells with the fontColorIndex function calls in them and then click away, or press F2 and then Enter, or do anything else that "re-enters" the formula into the cells with the font color counts, then the number(s) will update. 

    -Brian



    • Edited by Brian Skinn Tuesday, July 24, 2012 8:09 PM Correcting error, adding detail
    • Marked as answer by owl89410 Thursday, July 26, 2012 3:51 PM
    Tuesday, July 24, 2012 7:40 PM
  • With edit mentioned above its getting closer but now comes up with more than the four font colors that I have used. It adds additional four colors but counts them each just one time.  So now I have a more accurate but not perfect count by checking it manually. I get 8 colors plus black(or white?) showing a count of 0, four colors are close and four colors each show a count of 1.  I selected all the emply cells and hit delete to clear any residuals and I still get same results. The total of #cells counted is correct but there are incorrect # of colors(4 extra). One color of purple occupys just two cells but the count shows 3. Observing the locals window it seems the logic is not quite what I was hoping for. It's iterating through an array of colors rather  than an array of cells.  The latter is preferred so I can see each color increment as it steps thru the cells.   Instead, it counts thru the colors 1 to 9 many times with no idea of where in the range of  cells.count it is working on.  Would it be too much to ask to help rearrange the logic so it would perform that way?  I would get more functionality out of that way.  Thre results display fine below the column total in a 9r X 2c array.

    Thanks again.

    When I add and additional three cells in a black font none of the numbers increment by three so I'm not too trusting of it yet.


    Roliver

    • Marked as answer by owl89410 Wednesday, July 25, 2012 12:04 AM
    Tuesday, July 24, 2012 10:05 PM
  • Ok I've played with it some more on a small sheet with 10 cells and five colors and it works fine.  Found that my work piece had some cells that previously had data that had a different color and the data had been delected.  So apparently the cell fontcolor attribute gets retained even if the data value is deleted.  This has been a good instructive example as to how it iterates thru a simple two dimensional array.  Many thanks Sir Peter.

    Roliver

    • Marked as answer by owl89410 Thursday, July 26, 2012 3:51 PM
    Wednesday, July 25, 2012 12:08 AM

All replies

  • Hello:

    This is not a direct answer to your question, but some background that might be useful.  If you find a way to count the different colors in one statement, I will add it to my library!!

    I recently worked with an application that copied colors from a set of rows on a worksheet, and assigned the colors to other sheets depending on variables.

    I discovered that Basic colors are treated differently than theme colors, and I had to add error coding in case the color the user selected was not a theme color.

    For example, the first two lines of the code capture the theme color characteristics, and the 3rd and 4th line assign the same color to a range of cells on a different worksheet:

    ' ********************************************************
    ' Color Code The Line
    ' ********************************************************
        On Error GoTo ColorSelectionNotValid
        
        lngThemeColor = wksListDropDown.Cells(i, 14).Interior.ThemeColor
        dblTintAndShade = wksListDropDown.Cells(i, 14).Interior.TintAndShade
        Range(wksSchedule.Cells(lngScheduleCurrentRow, 1), wksSchedule.Cells(lngScheduleCurrentRow, 27)).Interior.ThemeColor = lngThemeColor
        Range(wksSchedule.Cells(lngScheduleCurrentRow, 1), wksSchedule.Cells(lngScheduleCurrentRow, 27)).Interior.TintAndShade = dblTintAndShade

    So, if you are using Theme colors, you could use the first two lines to capture the Theme Color and the Tint and Shade, and then compare and count each cell's colors.  The older "Basic" colors would cause lines three and four above to crash... only theme colors worked.

    So, you may have to factor in the type of color used and then write a subroutine to count and compare colors.

    Regards,


    Rich Locus, Logicwurks, LLC

    http://www.logicwurks.com


    • Edited by RichLocus Tuesday, July 24, 2012 1:52 AM
    Tuesday, July 24, 2012 1:50 AM
  • If Excel version is 2007 onwards then you can filter with Color.Just select the column click filter.And if you click the filter arrow you see an option with "Filter By Color"

    To do same in vba.Try recording macro the similar action.

    ---------------------------------------------------------------------------------------------

    Please do not forget to click “Vote as Helpful” if any post helps you and Mark as Answer if it solves the issue.

    Tuesday, July 24, 2012 7:12 AM
    Answerer
  • Try somehting like this -

    Sub CountFontClrs()
    Dim bFlag As Boolean
    Dim i As Long
    Dim TotClrs As Long, clr As Long
    Dim rng As Range, cel As Range
    Dim rngResults As Range
    ReDim arr(0 To 1, 1 To 100) As Long
            On Error GoTo errH
         Set rng = Range("A1:A800")
         Set rngResults = Range("B1")
            For Each cel In rng
                 clr = cel.Font.Color
                 bFlag = True
                 For i = 1 To TotClrs
                         If clr = arr(0, i) Then
                                 arr(1, i) = arr(1, i) + 1
                                 bFlag = False
                                 Exit For
                         End If
                 Next
                 If bFlag Then
                         TotClrs = TotClrs + 1
    99                        arr(1, TotClrs) = TotClrs
                         arr(0, TotClrs) = clr
                 End If
         Next
            ReDim Preserve arr(0 To 1, 1 To TotClrs)
            For i = 1 To TotClrs
                 rngResults.Cells(i, 1).Value = arr(0, i)
                 rngResults.Cells(i, 1).Font.Color = arr(0, i)
                 rngResults.Cells(i, 2).Value = arr(1, i)
         Next
         Exit Sub
    errH:
         If Erl = 99 And Err.Number = 9 Then
                 ReDim Preserve arr(0 To 1, 1 To UBound(arr, 2) + 100)
                 Resume
         Else
                 MsgBox Err.Description
         End If
    End Sub

    You might want to dump the results in some other way, adapt as required. Obviously change the respective range addresses to suit.

    Peter Thornton

    • Proposed as answer by Mike7952 Wednesday, July 25, 2012 11:35 AM
    • Marked as answer by owl89410 Thursday, July 26, 2012 3:52 PM
    Tuesday, July 24, 2012 11:56 AM
  • This looks like a more elegant solution that I think I need.  It puts the decimal value of each of the four colors it found in the cells below the row (displaying in its color) however and not the total of each color found.  Filtering mentioned above is not what I need as I do not need to view the results because it is counting similar items displayed in one of four colors, I just neet the totals of each color found.  I thought that since I'm using standard colors, some variation of the this function could be edited  =COUNTIF(AH5:AH494,".selection.font.color=vbblue") (THIS DOESN'T GIVE A ERROR BUT IT DOESN'T WORK EITHER) I'm not clear if the names as vbblue, vbgreen, vborange, vbpurple are equivalent to those standard menu colors in the font menu group.(?) I just want different colors to stand out on the page and don't care about their decimal values. If I use say five colors in a column to include black, then I could have five different formulas at the bottom of the column, one to count items in each color, or a combination to display the total of each color in its color as this does. Watching this run I'm curious why the i never gets higher than five, seems like it should increment each time the row number increases?? Further help needed to make this work. TIA.

    Roliver

    • Marked as answer by owl89410 Thursday, July 26, 2012 3:52 PM
    Tuesday, July 24, 2012 4:47 PM
  • The macro can't do what you describe, it should do this:

    - read the font colour of each cell in the range
    - loop through an array of previous matched colours
    - if found increment the total for that colour
    - if not found add the new colour the array and mark it's total found so far as 1

    - when done all the found colour-values (integers between 0-16777215) are dumped in a column, and in cells to the right a count of each of the found colours.
    -For convenience the font in the cell with the colour value is formatted with same.

    (This was only an example of how you might want to return the results, as I said adapt as required)

    The macro only returns whole integer numbers. If decimals are seen that's because the 'result' cells were already formatted to display decimals.

    However, there is a small error in the macro as originally posted, change

    arr(1, TotClrs) = TotClrs
    to
    arr(1, TotClrs) = 1

    Peter Thornton

    • Proposed as answer by Brian Skinn Wednesday, July 25, 2012 1:12 AM
    • Marked as answer by owl89410 Thursday, July 26, 2012 3:51 PM
    Tuesday, July 24, 2012 6:13 PM
  • As far as I know, COUNTIF will only operate on the value of the cells being counted -- the condition you enter as the second argument only has a comparison operator and a value, entered as a string, which could be programmatically determined.

    If you have a column on that same worksheet that you can use as a utility column, try the following.  Add the following macro function to the VB Project:

    Function fontColorIndex(cel As Range) As Long
        fontColorIndex = cel.Font.ColorIndex
    End Function

    In the utility column (say cell AI5, since your colored cells appear to be in column AH and the first data value is in row 5), enter as the formula "=colorIndex(AH5)".  Fill this formula all the way down the range AI5:AI494.  Then, in the location where you want to tabulate the cells counted the various colors, use "=COUNTIF(AH5:AH494,"=##", where you replace ## with one number index out of those of the particular colors you've used.  You'd then need to put this COUNTIF formula in however many more cells you need in order to count all of the colors you're interested in.

    Note that one downside of using this user-defined function is that it will only recalculate automatically if/when the numerical value of the cells being referred to (those in AH) changes.  Formatting changes to the cells do not automatically trigger recalculation, nor does a manual Calculation (F9, or via a menu command).  If you double-click the cells with the fontColorIndex function calls in them and then click away, or press F2 and then Enter, or do anything else that "re-enters" the formula into the cells with the font color counts, then the number(s) will update. 

    -Brian



    • Edited by Brian Skinn Tuesday, July 24, 2012 8:09 PM Correcting error, adding detail
    • Marked as answer by owl89410 Thursday, July 26, 2012 3:51 PM
    Tuesday, July 24, 2012 7:40 PM
  • With edit mentioned above its getting closer but now comes up with more than the four font colors that I have used. It adds additional four colors but counts them each just one time.  So now I have a more accurate but not perfect count by checking it manually. I get 8 colors plus black(or white?) showing a count of 0, four colors are close and four colors each show a count of 1.  I selected all the emply cells and hit delete to clear any residuals and I still get same results. The total of #cells counted is correct but there are incorrect # of colors(4 extra). One color of purple occupys just two cells but the count shows 3. Observing the locals window it seems the logic is not quite what I was hoping for. It's iterating through an array of colors rather  than an array of cells.  The latter is preferred so I can see each color increment as it steps thru the cells.   Instead, it counts thru the colors 1 to 9 many times with no idea of where in the range of  cells.count it is working on.  Would it be too much to ask to help rearrange the logic so it would perform that way?  I would get more functionality out of that way.  Thre results display fine below the column total in a 9r X 2c array.

    Thanks again.

    When I add and additional three cells in a black font none of the numbers increment by three so I'm not too trusting of it yet.


    Roliver

    • Marked as answer by owl89410 Wednesday, July 25, 2012 12:04 AM
    Tuesday, July 24, 2012 10:05 PM
  • Ok I've played with it some more on a small sheet with 10 cells and five colors and it works fine.  Found that my work piece had some cells that previously had data that had a different color and the data had been delected.  So apparently the cell fontcolor attribute gets retained even if the data value is deleted.  This has been a good instructive example as to how it iterates thru a simple two dimensional array.  Many thanks Sir Peter.

    Roliver

    • Marked as answer by owl89410 Thursday, July 26, 2012 3:51 PM
    Wednesday, July 25, 2012 12:08 AM
  • Re "So apparently the cell fontcolor attribute gets retained even if the data value is deleted"

    Indeed, cell formats persist even if the cell is empty. If you want to skip empty cells, ie don't count the font colours of those cells, add this IF check to the loop
            For Each cel In rng
               If Len(cel.Value) > 0 Then
                    ' count the font colours
               End If
          Next

    Peter Thornton

    • Proposed as answer by Mike7952 Wednesday, July 25, 2012 11:34 AM
    • Marked as answer by owl89410 Thursday, July 26, 2012 3:50 PM
    Wednesday, July 25, 2012 9:55 AM