View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Chip Pearson Chip Pearson is offline
external usenet poster
 
Posts: 7,247
Default a macro for conditional sum based on cell color index

I don't see where Conditional Formatting comes in, but you can sum
colored cells with the following function:

Function SumByColor(RR As Range, ColorIndex As Integer, _
Optional OfText As Boolean = False) As Variant
Dim R As Range
Dim Total As Double

If ColorIndex < 1 Or ColorIndex 56 Then
SumByColor = CVErr(xlErrValue)
Exit Function
End If
On Error GoTo ErrH:
For Each R In RR.Cells
If OfText = True Then
If R.Font.ColorIndex = ColorIndex Then
Total = Total + R.Value
End If
Else
If R.Interior.ColorIndex = ColorIndex Then
Total = Total + R.Value
End If
End If
Next R
SumByColor = Total
Exit Function
ErrH:
SumByColor = CVErr(xlErrNum)

End Function

Here, you pass in the range of cells to test, the ColorIndex (1 <=
ColorIndex <= 56), and TRUE or FALSE indicating whether to text the
color of the font (TRUE) or of the background fill (FALSE or omitted).
With this function, you can sum the cells in A1:A10 that have red
backgrounds with

=SumByColor(A1:A10,3,FALSE)
to sum by font color, use
=SumByColor(A1:A10,3,TRUE)

The functions returns #VALUE if ColorIndex is invalid, or #NUM if a
non-numeric value is found.

For lots more about working with colors in Excel, see
http://www.cpearson.com/excel/colors.aspx

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)



On Sun, 25 Jan 2009 13:26:02 -0800, Khoshravan
wrote:

My question: How do I use conditional formatting in Excel to sum highlighted
cells?
Answer: I find the following macro in the internet:
source: http://answers.google.com/answers/th.../id/67275.html
However it doesn't work and gives #value error. What is the problem with
this user-defined function?
If you have a better solution, let me know.

Function CFmt(RangeInQuotes, ColorIndex)

Dim Total As Double
Set Acell = Range(RangeInQuotes)
'Loop each cell in the range and if cell background eq to color index
sum it
For Each cell In Acell
If cell.Interior.ColorIndex = ColorIndex Then
Total = Total + cell.Value
End If
Next

CFmt = Total
End Function