Analyze(name, index, RGB of color), Count and Sum by fill color - Last updated:Sat, Jul 22, 2006 -
What If you would like to know the color name or to count or to sum cells by a fill color? There is no built-in
function in Excel. In this case you can make a User Defined Function (UDF). Here
are the sample UDF that you can analyze, count and sum the cells depending
on their filled color. These UDF function can be used in the same way as
built-in functions that you can use in the worksheet.
AnalyzeColor
Returns the color name, the color index or color index in RGB.
Syntax: AnalyzeColor(color range, optional; "text" or "index" or "rgb". When it is omitted "text" is used.)
CountColor
Counts the number of cells depending on their filled color.
Syntax: CountColor(color range, target range)
SumColor
Adds all the numbers in a range of cells depending on their filled color.
Syntax: SumColor(color range, target range)
Example
Please have a look at the picture below. Basically these UDF available only in the workbook that contains these UDF procedures.
If you'd like to use these UDF in other workbooks, I would reccomend you to make an add-in workbook and place these in there.
Or place these code in your Personal.xls. Because it's handy.
Please note, when you change the fill color of cells, it will not cause these UDF to recalculate, even if you press F9 key.
As a way of avoidance, there is a method of including volatile functions (function always re-calculated), such as a NOW function, in a formula like this.
=SumColor(C11,A11:H11)+ NOW()*0 But if you use this way many times, it would make the calculation speed slow.
Download
Place the following in a standard module.
You can download the sample workbook from here.
sample_072.zip| downloaded 1328 time(s)
Option Explicit
Option Base 1
Function CountColor(ColorRange As Range, Target As Range) As Long
Dim c As Range
For Each c In Target
If c.Interior.ColorIndex = ColorRange.Interior.ColorIndex Then
CountColor = CountColor + 1
End If
Next
End Function
Function AnalyzeColor(Target As Range, Optional sType As String = "text")
Dim aIdx As Variant
Dim aClr As Variant
Dim ret As Variant
aIdx = Array(1, 53, 52, 51, 49, 11, 55, 56, 9, 46, 12, _
10, 14, 5, 47, 16, 3, 45, 43, 50, 42, 41, _
13, 48, 7, 44, 6, 4, 8, 33, 54, 15, 38, 40, _
36, 35, 34, 37, 39, 2)
aClr = Array("Black", "Brown", "Olive Green", "Dark Green", "Dark Teal", _
"Dark Blue", "Indigo", "Gray-80%", "Dark Red", "Orange", "Dark Yellow", _
"Green", "Teal", "Blue", "Blue-Gray", "Gray-50%", "Red", "Light Orange", _
"Lime", "Sea Green", "Aqua", "Light Blue", "Violet", "Gray-40%", "Pink", _
"Gold", "Yellow", "Bright Green", "Turqoise", "Sky Blue", "Plum", _
"Gray-25%", "Rose", "Tan", "Light Yellow", "Light Green", "Light Turqoise", _
"Pale Blue", "Lavendar", "White")
ret = Application.Match(Target.Interior.ColorIndex, aIdx, 0)
sType = LCase(sType)
Select Case sType
Case "text"
AnalyzeColor = IIf(IsError(ret), "Custom Color or No Color", aClr(ret))
Case "index"
AnalyzeColor = IIf(IsError(ret), CLng(xlNone), aIdx(ret))
Case "rgb"
AnalyzeColor = IIf(IsError(ret), GetRGB(xlNone), GetRGB(CLng(aIdx(ret))))
End Select
End Function
Function SumColor(ColorRange As Range, Target As Range)
Dim c As Range
Dim rColor As Range
For Each c In Target
If c.Interior.ColorIndex = ColorRange.Interior.ColorIndex Then
If rColor Is Nothing Then
Set rColor = c
Else
Set rColor = Union(rColor, c)
End If
End If
Next
If rColor Is Nothing Then
SumColor = 0
Else
SumColor = Application.WorksheetFunction.Sum(rColor)
End If
End Function
Function GetRGB(lColor As Long) As Variant
Dim r As Long
Dim g As Long
Dim b As Long
r = lColor Mod 256
g = Int(lColor / 256) Mod 256
b = Int(lColor / 256 / 256)
GetRGB = "#" & Right("0" & Hex(r), 2) & _
Right("0" & Hex(g), 2) & _
Right("0" & Hex(b), 2)
End Function
Analyze(name, index, RGB of color), Count and Sum by fill color
