I am trying to count the number of cells that have a blue font and It won't work. I can count cells with a red font but not blue. This is a custom function I have created using VBA
Function GetFontColorCount(CountRange As Range, CountColor As Range)
Dim CountColorValue As Integer
Dim TotalCount As Integer
CountColorValue = CountColor.Font.Color
Set rCell = CountRange
For Each rCell In CountRange
If rCell.Font.Color = CountColorValue And rCell.Value >= 1 Then
TotalCount = TotalCount + 1
End If
Next rCell
GetFontColorCount = TotalCount
End Function
When using the formula It will count red font and black but not blue or any of the other colors that I have tried.
The following procedures assume that the target range is in E6: I18
and that a sample range is used that contains each of the font colors to be counted (the sample range is in B2: B5
)
Sub GetFontColorCount_TEST()
Dim rTrg As Range
Dim rColor As Range
Dim rCll As Range
Rem Set Ranges
With ThisWorkbook.Worksheets("DATA") 'Update as required
Set rTrg = .Range("E6:I18") 'Update as required
Set rColor = .Range("B2:B5") 'Update as required
End With
Rem Get Font Color Count and enter the value besides the sample cell
For Each rCll In rColor
rCll.Offset(0, 1).Value2 = Range_ƒFontColor_Count(rTrg, rCll)
Next
End Sub
.
Function Range_ƒFontColor_Count(rTrg As Range, rColor As Range)
Dim lColor As Long
Dim lColorCnt As Byte
Dim rCll As Range
Rem Set sample Font Color
lColor = rColor.Font.Color
Rem Count cells with sample Font Color
For Each rCll In rTrg.Cells
If rCll.Font.Color = lColor Then lColorCnt = 1 + lColorCnt
Next
Range_ƒFontColor_Count = lColorCnt
End Function
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.