![]() |
#4
|
|||
|
|||
![]()
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 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. |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
ScotsMaverick | Mail Merge | 25 | 11-04-2021 02:07 PM |
![]() |
gazza uk | Excel | 6 | 05-29-2014 09:52 AM |
VBA to immediately change the colour of a cell depending on the code placed in anothe | Phil Payne | Excel Programming | 2 | 07-27-2013 11:04 PM |
![]() |
RoyLittle0 | Excel | 2 | 05-05-2013 12:50 AM |
CHange colour of footer if a cell changes to red | OTPM | Excel | 0 | 05-26-2011 07:15 AM |