VBA TIPS
Analyze(name, index, RGB of color), Count and Sum by fill color

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.

wks image


Download

Place the following in a standard module.

You can download the sample workbook from here. sample_072.zip  | downloaded  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 LongAs 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

| HOME |
Copyright © cellmasters.net - colo's junk room All Right Reserved
ABOUT
WORKS
THE CELL MASTERS
CONTACT
LINKS
Tips and Information about Microsoft Excel|Masaru Kaji aka Colo