![]() |
|
#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. |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
Colour code mail merge header table cell backgrounds
|
ScotsMaverick | Mail Merge | 25 | 11-04-2021 02:07 PM |
colour codeing a cell by entering data
|
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 |
Quadrant colour based on cell value
|
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 |