Solved

SumByColor is not working

Posted on 2009-07-09
4
1,026 Views
Last Modified: 2012-08-14
I am using this formula to sum the values of the tan cells in the identified range but all I get for the value is #NAME?

=SumByColor(B2:B34, 40)
0
Comment
Question by:SpyderGST1
4 Comments
 
LVL 5

Accepted Solution

by:
bboswell earned 250 total points
ID: 24819886
I don't think there is a function in Excel called SumByColor. There is how ever a function that I located at Excel-Tips.com (http://exceltip.com/st/Sum_by_color_using_VBA_in_Microsoft_Excel/517.html)

You would need this in the Macro section first for this function to work.
Function SumByColor(InputRange As Range, ColorRange As Range) As Double

' returns the sum of each cell in the range InputRange that has the same

' background color as the cell in ColorRange

' example: =SumByColor($A$1:$A$20,B1)

' range A1:A20 is the range you want to sum

' range B1 is a cell with the background color you want to sum

Dim cl As Range, TempSum As Double, ColorIndex As Integer

    ' Application.Volatile ' this is optional

    ColorIndex = ColorRange.Cells(1, 1).Interior.ColorIndex

    TempSum = 0

    On Error Resume Next ' ignore cells without values

    For Each cl In InputRange.Cells

        If cl.Interior.ColorIndex = ColorIndex Then 

            TempSum = TempSum + cl.Value

        End If

    Next cl

    On Error GoTo 0

    Set cl = Nothing

    SumByColor = TempSum

End Function

Open in new window

0
 
LVL 12

Expert Comment

by:kgerb
ID: 24820202
Hi SpyderGST1,
This is a UDF created by Chip Pearson.  It will sum values by interior color (among other things).

http://www.cpearson.com/Excel/colors.aspx

Let me know if you have questions on how to implement.

Kyle
Function SumColor(TestRange As Range, SumRange As Range, _

    ColorIndex As Long, Optional OfText As Boolean = False) As Variant

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' SumColor

' This function returns the sum of the values in SumRange where

' the corresponding cell in TestRange has a ColorIndex (of the

' Font is OfText is True, or of the Interior is OfText is omitted

' or False) equal to the specified ColorIndex. TestRange and

' SumRange may refer to the same range. An xlErrRef (#REF) error

' is returned if either TestRange or SumRange has more than one

' area or if TestRange and SumRange have differing number of

' either rows or columns. An xlErrValue (#VALUE) error is

' returned if ColorIndex is not a valid ColorIndex value.

' If ColorIndex is 0, xlColorIndexNone is used if OfText is

' False or xlColorIndexAutomatic if OfText is True. This allows

' the caller to specify 0 for no color applied.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim D As Double

Dim N As Long

Dim CI As Long
 

Application.Volatile True

If (TestRange.Areas.Count > 1) Or _

    (SumRange.Areas.Count > 1) Or _

    (TestRange.Rows.Count <> SumRange.Rows.Count) Or _

    (TestRange.Columns.Count <> SumRange.Columns.Count) Then

    SumColor = CVErr(xlErrRef)

    Exit Function

End If

    

If ColorIndex = 0 Then

    If OfText = False Then

        CI = xlColorIndexNone

    Else

        CI = xlColorIndexAutomatic

    End If

Else

    CI = ColorIndex

End If
 

Select Case CI

    Case 0, xlColorIndexAutomatic, xlColorIndexNone

        ' ok

    Case Else

        If IsValidColorIndex(ColorIndex:=ColorIndex) = False Then

            SumColor = CVErr(xlErrValue)

            Exit Function

        End If

End Select
 

For N = 1 To TestRange.Cells.Count

    With TestRange.Cells(N)

    If OfText = True Then

        If .Font.ColorIndex = CI Then

            If IsNumeric(.Value) = True Then

                D = D + .Value

            End If

        End If

    Else

        If .Interior.ColorIndex = CI Then

            If IsNumeric(.Value) = True Then

                D = D + .Value

            End If

        End If

    End If

    End With

Next N

            

SumColor = D
 

End Function

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24820366
Hello SpyderGST1,

The error message suggests you have the function in the wrong place .. it should reside in a normal code module i.e. NOT a class, worksheet or workbook code module

Regards,
Chris
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
iPhone excel activation issues 11 69
Need help with excel question, fill in cell below category? 7 32
ADD New Entries 7 16
Excel callender with date slider 5 27
Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now