COUNTFORMAT
4 Functions that allow you to count different types of formatting.
COUNTFORMAT
Returns the number of cells that have been formatted with multiple attributes.
This function will not update automatically every time a cell format changes although pressing F9 will work.
Option Explicit
'rgeValues - The range of values.
'rgeExampleCell - The cell whose format you want to match.
'bBackGround - Whether you want to check the background formatting.
'bText - Whether you want to check the text formatting.
Public Function COUNTFORMAT(ByVal rgeValues As Range, _
ByVal rgeExampleCell As Range, _
Optional ByVal bBackGround As Boolean = True, _
Optional ByVal bText As Boolean = False) As Integer
Dim objCell As Range
Dim itotalcells As Integer
itotalcells = 0
If bBackGround = True Then
For Each objCell In rgeValues
If objCell.Interior.ColorIndex = rgeExampleCell.Interior.ColorIndex Then
itotalcells = itotalcells + 1
End If
Next objCell
End If
If bText = True Then
For Each objCell In rgeValues
If objCell.Font.ColorIndex = rgeExampleCell.Font.ColorIndex Then
itotalcells = itotalcells + 1
End If
Next objCell
End If
COUNTFORMAT = itotalcells
End Function
![]() |
COUNTFORMAT_CELLCOLOR
Returns the number of cells that have been formatted with a particular colour.
'rgeSearchCells - The range of cells you want to check.
'rgeCriteriaCell - The cell with the colour to count.
Public Function COUNTCOLOR(ByVal rgeColouredCells As Range, _
ByVal iColourIndex As Integer) As Integer
Dim rgeCell As Range
For Each rgeCell in rgeColouredCells
If rgeCell.Interior.ColorIndex = iColourIndex Then
COUNTCOLOR = COUNTCOLOR + 1
End If
Next rgeCell
End Function
COUNTFORMAT_FONTBOLD
Returns the number of cells that have been formatted in bold.
'rgeSearchCells - The range of cells you want to check.
'rgeCriteriaCell
COUNTFORMAT_FONTCOLOR
Returns the number of cells that have been formatted with a particular font colour.
'rgeSearchCells - The range of cells you want to check.
'rgeCriteriaCell
Public Function COUNTBYFONTCOLOR( _
ByVal rgeSearchCells As Range, _
ByVal rgeCriteriaCell As Range) As Long
Dim ltotal As Long
Dim lfontcolor As Long
Dim rgeCell As Range
lfontcolor = rgeCell.Font.Color
For Each rgeCell In rgeSearchCells
If (rgeCell.Font.Color = lfontcolor) Then
ltotal = ltotal + 1
End If
Next rgeCell
COUNTBYFONTCOLOR = ltotal
End Function
© 2021 Better Solutions Limited. All Rights Reserved. © 2021 Better Solutions Limited TopPrevNext