View Single Post
 
Old 05-17-2017, 02:21 PM
Logit Logit is offline Windows 10 Office 2007
Expert
 
Join Date: Jan 2017
Posts: 591
Logit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the rough
Default

Paste this code in the Sheet Level Module:

Code:
Option Explicit

Sub cmdBtn1()
   Sheets("Sheet1").Range("A3").Value = "=ColorFunction(A3,B2:C100,TRUE)"
End Sub

Sub cmdBtn2()
   Sheets("Sheet1").Range("A7").Value = "=ColorFunction(A7,B2:C100,TRUE)"
End Sub
Paste this code into a Routine Module:

Code:
Option Explicit

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult
lCol = rColor.Interior.ColorIndex
    If SUM = True Then
        For Each rCell In rRange
                If rCell.Interior.ColorIndex = lCol Then
                    vResult = WorksheetFunction.SUM(rCell, vResult)
                End If
        Next rCell
            Else
                For Each rCell In rRange
                    If rCell.Interior.ColorIndex = lCol Then
                        vResult = 1 + vResult
                    End If
                Next rCell
    End If
ColorFunction = vResult
End Function

You can expand the colors and buttons by following the pattern in the code.
Attached Files
File Type: xlsm Sum By Color.xlsm (18.2 KB, 13 views)
Reply With Quote