Sum by color

  • Thread starter Thread starter Mark Hamblin
  • Start date Start date
M

Mark Hamblin

I would like to sum a column of numbers based on the colour of the cell.

E.g. add the contents of all the red cells in a defined column group


TIA

Mark
 
Mark,

It is not easy, but if you input the function supplied at the end, you can
do it with this formula

=SUMPRODUCT(--(ColorIndex(A1:A100)=3))

if you want the text colour, use

=SUMPRODUCT(--(ColorIndex(A1:A100,TRUE)=3))

You could also set another cell, say C1, to the colour red, and test like
this

=SUMPRODUCT(--(ColorIndex(A1:A100)=ColorIndex(C1)))


Here's the function

'---------------------------------------------------------------------
Function ColorIndex(rng As Range, _
Optional text As Boolean = False) As Variant
'---------------------------------------------------------------------
' Function: Returns the colorindex of the supplied range
' Synopsis:
' Author: Bob Phillips/Harlan Grove
'
'---------------------------------------------------------------------
Dim cell As Range, row As Range
Dim i As Long, j As Long
Dim iWhite As Long, iBlack As Long
Dim aryColours As Variant

If rng.Areas.Count > 1 Then
ColorIndex = CVErr(xlErrValue)
Exit Function
End If

iWhite = WhiteColorindex(rng.Worksheet.Parent)
iBlack = BlackColorindex(rng.Worksheet.Parent)

If rng.Cells.Count = 1 Then
If text Then
aryColours = DecodeColorIndex(rng, True, iBlack)
Else
aryColours = DecodeColorIndex(rng, False, iWhite)
End If

Else
aryColours = rng.Value
i = 0

For Each row In rng.Rows
i = i + 1
j = 0

For Each cell In row.Cells
j = j + 1

If text Then
aryColours(i, j) = DecodeColorIndex(cell, True, iBlack)
Else
aryColours(i, j) = DecodeColorIndex(cell, False, iWhite)
End If

Next cell

Next row

End If

ColorIndex = aryColours

End Function

Private Function WhiteColorindex(oWB As Workbook)
Dim iPalette As Long
WhiteColorindex = 0
For iPalette = 1 To 56
If oWB.Colors(iPalette) = &HFFFFFF Then
WhiteColorindex = iPalette
Exit Function
End If
Next iPalette
End Function

Private Function BlackColorindex(oWB As Workbook)
Dim iPalette As Long
BlackColorindex = 0
For iPalette = 1 To 56
If oWB.Colors(iPalette) = &H0 Then
BlackColorindex = iPalette
Exit Function
End If
Next iPalette
End Function

Private Function DecodeColorIndex(rng As Range, text As Boolean, idx As
Long)
Dim iColor As Long
If text Then
iColor = rng.font.ColorIndex
Else
iColor = rng.Interior.ColorIndex
End If
If iColor < 0 Then
iColor = idx
End If
DecodeColorIndex = iColor
End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Bob Phillips said:
Mark,

It is not easy, but if you input the function supplied at the end, you can
do it with this formula

=SUMPRODUCT(--(ColorIndex(A1:A100)=3))
Click to expand...

Haven't tried that one but for what it's worth, this can probably be done by
writing a macro too.
 
Chris Roberts said:
Haven't tried that one but for what it's worth, this can probably be done by
writing a macro too.
Click to expand...

Yeah, of course it can, but IMO it is best to keep the macro, the ColorIndex
function, as fundamental as possible, and then use built-in Excel functions
to do the rest, For instance, if the function did the counting, you wouldn't
be able to use this form
=SUMPRODUCT(--(ColorIndex(A1:A100)=ColorIndex(C1))). Also, you wouldn't be
able to use it to sort by colour. So where is the advantage there?
 
Back
Top