count occurences of font color

[michalaw]

I have a spreadsheet of coded survey responses. The code(s) applied to each
response are indicated by changing the font color of specific words in the
text. For example, the response "I like dogs and cats" would have "dogs"
colored red to indicate that it is in the Dogs category, and "cats" colored
blue to indicate that it is in the Cats category.
I'm trying to write a macro that produces a count of how many times each
font color occurs in a range of cells by examining the characters in each
response. The code I have developed thus far is this:

Function CountBlue(MyRange As Range)
Dim iCount As Integer
Application.Volatile
iCount = 0
For Each Cell In MyRange
If Cell.Font.ColorIndex = 41 Then
iCount = iCount + 1
End If
Next Cell
CountBlue = iCount
End Function

However, it returns a 0 when I try to use it in my spreadsheet. I am fairly
certain that something is wrong in the If/Then statement, but I don't know
what. Can anyone help me?

 

[Tom Ogilvy]

If you are coloring characters within the text string within the cell, then
you have to examine the characters as you have stated. Your function
doesn't do this.


Function CountBlue(MyRange As Range)
Dim iCount As Long, i as Long
Application.Volatile
iCount = 0
For Each Cell In MyRange
for i = 1 to len(cell.value)
If Cell.Characters(i,1).Font.ColorIndex = 41 Then
iCount = iCount + 1
exit for
End If
Next i
Next Cell
CountBlue = iCount
End Function

Make sure the color you are using for blue is actually ColorIndex 41
Assumes that you won't have a cell that has "My dog is a big dog" with
two blue dogs that need to be counted separately.

 

[michalaw]

That does it! Thank you so much!
If you don't mind, could you help me understand exactly what 2 of the lines
do?

"for i = 1 to len(cell.value)"
Does this establish i as the length of the text string in the cell?

"If Cell.Characters(i,1).Font.ColorIndex = 41 Then"
I think the (i,1) part tells the function to examine certain characters
within the string - is this correct?
Thanks again for your help!

 

[keepITcool]

this will make your processing extremely slow.
as you are working with partially colored text strings.

for partially colored text, the cell's font color will return a NULL
value and you must go thru each character! of the text.

Function CountBlue(MyRange As Range) As Long
CountBlue = ColorCount(MyRange, 41)
End Function
Function CountRed(MyRange As Range) As Long
CountRed = ColorCount(MyRange, 3)
End Function


Function ColorCount(ByVal rRange As Range, ByVal iColor As Long) As Long
Dim rCell As Range
Dim i&, n&

'Reduce the range to "entered text" only
On Error Resume Next
Set rRange = rRange.SpecialCells(xlCellTypeConstants, xlTextValues)
If rRange Is Nothing Then Exit Function
On Error GoTo 0

For Each rCell In rRange.Cells
With rCell
If IsNull(.Font.ColorIndex) Then
'Text Font is partially colored
For i = 1 To Len(.Value)
If .Characters(i, 1).Font.ColorIndex = iColor Then
n = n + 1
Exit For
End If
Next
ElseIf .Font.ColorIndex = iColor Then
'Cell Font is colored
n = n + 1
End If
End With
Next

ColorCount = n

End Function

HTH


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


michalaw wrote :

 

[Tom Ogilvy]

it tells i to successively take on the values from 1 to the number of
characters in the string.

then you look at each character as you correctly interpreted

cell.Characters(character position, number of characters)

In your case, number of characters would be 1.

You could also avoid macros and do something like

=Countif(B:B,"*dog*")

as long as dog would appear only once in each cell of interest.

 

[Tom Ogilvy]

You could ignore the Null test and just jump out when the first matching
color is found (as I suggested in my earlier answer). It would work in
either case.

ActiveCell.Font.ColorIndex = 41
? ActiveCell.Characters(1,1).Font.ColorIndex
41

 

[keepITcool]

Tom,

Not true. The null test is there to avoid the loop
when the cell(not partial text) is formatted.
in a likely scenario most cells will have
CELL.font.colorindex = xlAutomatic

and your code must loop all characters to find out.


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Tom Ogilvy wrote :

 

[Tom Ogilvy]

Not true. Your isnull test determines the need to loop or not. If it is
null, you loop. No difference there in approaches except the extra test.

If it isn't null, you check the font color of the range. In that case, my
checking the first character would stop the loop just as easily with no
additional looping..

For Each rCell In rRange.Cells
With rCell
For i = 1 To Len(.Value)
If .Characters(i, 1).Font.ColorIndex = iColor Then
n = n + 1
Exit For
End If
End If
End With
Next

Should be just as effective. No looping through xlautomatic except in the
same situations your original code. would. loop.

 

[keepITcool]

Tom,

Please rethink: The difference is in the cells which have NOT been
partially formatted.

For a cell which has an entire blue font there is hardly any difference
as the loop will exit on the first character. (although the isnull is
more efficient (factor 10) as it avoids the characters method.)

However:
if a cell is (entirely) formatted as Auto or Red (not blue) then your
code must complete the loop to determine that all
..Characters(i,1).font.colorindex <> 41

Run a test:
1000 rows with text of 30 chars.

..cells.font.colorindex= 41
my code: .05 secs.
your code: .66 secs.


..cells.font.colorindex=xlAutomatic or vbRed
my code: .05 secs.
your code: 20.00 secs




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Tom Ogilvy wrote :

 

[Tom Ogilvy]

I agree, your check is faster, but I am not seeing those types of
differences.

If we cull it down to the essence of the discussion:

Sub Tester1()
Dim s As Single, e As Single
Dim num As Long, res As Long
Dim b As Boolean
num = 100000
s = Timer
For i = 1 To num
' res = ActiveCell.Characters(1, 1).Font.ColorIndex
Next
Debug.Print Timer - s
s = Timer
For i = 1 To num
' b = IsNull(ActiveCell.Font.ColorIndex)
' res = ActiveCell.Font.ColorIndex
Next
Debug.Print Timer - s
End Sub


I get differences like this

2.191406 ' using characters
1.378906 ' using isnull and not using characters

 

[keepITcool]

Tom

very often you are correct, but this time I am <VBG>.
the BIG difference is when to return False fast.

Sub CullTheEssenceWithASmile()
Dim t!(1), v(1), n&, m&, i&

With ActiveCell
.Value = String(25, "x")
.Font.ColorIndex = xlAutomatic
m = 100
t(0) = Timer
For n = 1 To m
For i = 1 To Len(.Value)
If .Characters(i, 1).Font.ColorIndex = 41 Then
v(0) = True
Exit For
End If
Next i
Next n
t(0) = Timer - t(0)


t(1) = Timer
For n = 1 To m
If IsNull(.Font.ColorIndex) Then
For i = 1 To Len(.Value)
If .Characters(i, 1).Font.ColorIndex = 41 Then
v(1) = True
Exit For
End If
Next i
Else
v(1) = (.Font.ColorIndex = 41)
End If
Next n
t(1) = Timer - t(1)
End With

MsgBox t(0) & vbLf & t(1)

End Sub




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Tom Ogilvy wrote :

 

[Tom Ogilvy]

After further reflection, I agree - you are correct. My bad.

 

[michalaw]

I'm a little bit lost among all these different bits of code...would someone
be willing to sum up for me what the agreed-upon faster code to accomplish
the goal is?

 

[keepITcool]

Take the code from my original post dated Feb3rd 20:27

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


michalaw wrote :