sum if cell color

Posted on 2009-12-22
Last Modified: 2012-05-08
need to sum different cells if color is yellow or red etc.
also meets criteria in b2.b22 = b25
Question by:spirodem

    Author Comment

    answer in e25
    LVL 9

    Expert Comment

    I need more information on this.
    Can you again re-draft your conditions for the attached workbook?
    LVL 45

    Accepted Solution


    The code below is in the attached file. Press the button to get the results.

    Sub specialmacro()
    Dim rng As Range
    Dim rng2 As Range
    Dim celle As Range
    Dim coll As New Collection
    Dim i As Long
    Dim rowe As Long
    Dim colm As Long
    Dim ttl As Double
    With Sheets("Sheet1")
        Set rng = Range(.Cells(2, "G"), .Cells(.Rows.Count, "B").End(xlUp).Offset(0, 11))
        For Each celle In rng
            On Error Resume Next
            coll.Add CStr(celle.Interior.ColorIndex), CStr(celle.Interior.ColorIndex)
        Next celle
        For colm = 7 To 13
            For rowe = 1 To coll.Count
                .Cells(rowe + 22, colm).Interior.ColorIndex = --coll(rowe)
                Set rng2 = Range(.Cells(2, colm), .Cells(rng.Rows.Count + 1, colm))
                For Each celle In rng2
                    If celle.Interior.ColorIndex = --coll(rowe) Then
                        ttl = ttl + celle
                    End If
                    .Cells(rowe + 22, colm) = ttl
                    .Cells(rowe + 22, colm).NumberFormat = "[$$-409]#,##0.00"
                Next celle
            ttl = 0
            Next rowe
        Next colm
    End With
    End Sub

    Open in new window

    LVL 18

    Expert Comment



    Function GETCOLOR(r As Range) As Long
    'To get the interior color index
    GETCOLOR = r.Interior.ColorIndex
    End Function
    Function SUMBYCC(LR As Range, CR, SR As Range, C2S As Long) As Double
    'LR - Lookup Range
    'CR - Criteria
    'SR - Sum Range
    'C2S - Color to Sum
    'sum by color and one criteria
    Dim a, i As Long
    a = LR
    If IsArray(a) Then
        For i = 1 To UBound(a, 1)
            If LCase$(a(i, 1)) = LCase$(CR) Then
                If SR.Cells(i, 1).Interior.ColorIndex = C2S Then
                    SUMBYCC = SUMBYCC + SR.Cells(i, 1)
                End If
            End If
        If LCase$(a) = LCase$(CR) Then
            If SR.Cells(1, 1).Interior.ColorIndex = C2S Then SUMBYCC = SR.Cells(i, 1)
        End If
    End If
    End Function
    Function SUMBYC(SR As Range, C2S) As Double
    'SR - Sum Range
    'C2S - Color to Sum
    'sum by color
    Dim i As Long
    For i = 1 To SR.Rows.Count
        If SR.Cells(i, 1).Interior.ColorIndex = C2S Then
            SUMBYC = SUMBYC + SR.Cells(i, 1)
        End If
    End Function

    Open in new window

    LVL 45

    Expert Comment

    spirodem - Thanks for the grade - Patrick

    Featured Post

    Looking for New Ways to Advertise?

    Engage with tech pros in our community with native advertising, as a Vendor Expert, and more.

    Join & Write a Comment

    Suggested Solutions

    Title # Comments Views Activity
    MS Excel Cell questions 5 40
    Protecting an object 3 25
    VBA filters 2 24
    extract numbers / text from a column 2 29
    We were having a lot of "Heartbeat Alerts" in our SCOM environment, now "Heartbeat" in a SCOM environment for those of you who might not be familiar with SCOM is a packet of data sent from the agent to the management server on a regular basis, basic…
    Lync meeting or Lync conferencing is what many organizations would like to deploy to allow them save money. But companies are now giving up for various reasons, one of which is that they cannot join external meetings (non-federated company meetings)…
    This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
    Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

    733 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

    17 Experts available now in Live!

    Get 1:1 Help Now