sum the color cells

[reza]

hi all.

i have data with different color.
i one column i have 3 color, blue, yellow and red.
now i want to count & sum based on the colors.
how to create formula for that?

many thanks...

reza

 

[FSt1]

hi,
you have xl07 or higher, you are suppose to have this capability already.
see help. i am having research trouble confirming that. if you have xl03 or
earlier, see this site....
http://cpearson.com/excel/colors.aspx

regards
FSt1

 

[reza]

HI FSt1...

sorry, i use 2007....
is that link compatible with 07?

thanks

 

[L. Howard Kittle]

Give this a try. Copy and right click on the sheet tab and paste in the
sheet module. Provides a summation list in F10, F11 & F12 along with a
Message Bos of the results.

Probably want to try on a test worksheet first.

Sums the values of all Blue, Red and Yellow formatted cells in A1:A1000.

Will not work on conditional formatted cells.

If you are trying to sum the colors of the FONTS of each cell in A:A then
post back. That is quite possible also.

Sub SumColorCount()
Dim Blue5 As Integer, _
Red3 As Integer, _
Yellow6 As Integer
Dim Data As Range
Dim Cell As Range

Set Data = Range("A1:A1000")
For Each Cell In Range("Data")
If Cell.Interior.ColorIndex = 5 Then
Blue5 = Blue5 + Cell.Value
ElseIf Cell.Interior.ColorIndex = 3 Then
Red3 = Red3 + Cell.Value
ElseIf Cell.Interior.ColorIndex = 6 Then
Yellow6 = Yellow6 + Cell.Value
End If
Next

Range("F10").Value = "Blue = " & Blue5
Range("F11").Value = "Red = " & Red3
Range("F12").Value = "Yellow = " & Yellow6

MsgBox " You have: " & vbCr _
& vbCr & " Blue " & Blue5 _
& vbCr & " Red " & Red3 _
& vbCr & " Yellow " & Yellow6, _
vbOKOnly, "CountColor"

Range("F10:F12").Value = ""

End Sub


HTH
Regards,
Howard

 

[reza]

Howard...

i already try, copy your code then paste in module...
but there were a bug in
Run-time error '1004':
method 'Range' of object'_Global' failed
when i click debug, it will go to:
For Each Cell In Range("Data")

thanks

 

[reza]

Howard...

just ignored it my message before... already succeed.
but what i want to achieve is create a real sum in cell, not only message
box and can update every time any changes...
using a real formula...

thanks before

 

[Chip Pearson]

Here are two functions that will Sum and Count cells based on color.
In each function, RR is the range to test, ColorIndex is the color
index value to test for, and OfText indicates whether to test the font
color (OfText = True) or the background fill color (OfText = False).

Note that simply changing a cell's formatting or color does not cause
a calculation so you will need to force a calculation to ensure the
values are correct.


Function SumColor(RR As Range, ColorIndex As Long, _
OfText As Boolean) As Double
Dim R As Range
Dim D As Double

For Each R In RR.Cells
If IsNumeric(R.Value) Then
If OfText = True Then
If R.Font.ColorIndex = ColorIndex Then
D = D + R.Value
End If
Else
If R.Interior.ColorIndex = ColorIndex Then
D = D + R.Value
End If
End If
End If
Next R
SumColor = D
End Function

Function CountColor(RR As Range, ColorIndex As Long, _
OfText As Boolean) As Double
Dim R As Range
Dim D As Double

For Each R In RR.Cells
If OfText = True Then
If R.Font.ColorIndex = ColorIndex Then
D = D + 1
End If
Else
If R.Interior.ColorIndex = ColorIndex Then
D = D + 1
End If
End If
Next R
CountColor = D
End Function

You can then call these functions from worksheet cells with formulas
like

=SumColor(A1:A100,3,FALSE)
to sum all entries in A1:A100 that have a background color of red (3).

=CountColor(A1:A100,3,TRUE)
to count all the entries in A1:A100 that have a font color of red (3).

See Help for a list of color index values and their corresponding
color.

Cordially,
Chip Pearson
Microsoft Most Valuable Professional,
Excel, 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com

 

[Gord Dibben]

You say you have Excel 2007.

You can filter by color and use the SUBTOTAL function.

=SUBTOTAL(9,A1:A100)

Filter for blue and see the sum of blue cells.

=SUBTOTAL(2,A1:A100)

Filter on blue cells and see the count of blue cells.


Gord Dibben MS Excel MVP