Counting number of black characters in a sentence

Question

I have a list of sentences, some of the characters in the sentences are colored green (colorindex = 10), some are colored blue (colorindex = 5) and some are colored black. I would like to calculate the proportion of each sentence which is colored either blue or green.

I have written a macro which loops through each character in each sentence and determines what color it is, then spits out the proportion of non-black colored characters in that sentence. The problem is that this is very slow, I believe there are more advanced techniques which can be used in VBA such as storing information in an array then spitting it out as an array at the end. I'm not too sure, if someone could may me make this faster it would be much appreciated!

The code in this query Count keywords within phrases does something very similar but in a fraction of the time.

Here is what I have so far: The sentences are in Range("B2:B1000")

Dim x As Integer, Black As Integer, y As Integer

x = 2
Do Until Cells(x, 2) = ""
Black = 0
For y = 1 To Len(Cells(x, 2))
    If Cells(x, 2).Characters(y, 1).Font.ColorIndex = 1 Then
        Black = Black + 1
    Else
    End If

Next y
Cells(x, 3).FormulaR1C1 = "=1-" & Black & "/LEN(RC[-1])"

x = x + 1
Loop

I think this will be inherently slow since you have to use the `Characters` property but it may be faster to do one `Select Case Cells(x, 2).Characters(y, 1).Font.ColorIndex` rather than checking it twice per character. — Rory, Dec 09 '15 at 09:30
Won't this code count spaces aswell, since their ColorIndex is neither 5 nor 10 ? Don't know if that is intented or if your strings even contain spaces, just pointing it out. — Vulthil, Dec 09 '15 at 09:43
Could someone please help me with this?! I really need to get this running a lot faster. Thanks — Simon, Dec 10 '15 at 10:32

Sergey Ryabov · Answer 1 · 2015-12-09T10:30:20.773

0

I managed to speed it up by 100+% using following code:

Dim x As Integer, Black As Integer, y As Integer

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual

lr = Cells(Rows.Count, 2).End(xlUp).Row

For x = 2 To lr
    Black = 0
    For y = 1 To Len(Cells(x, 2))
        If Cells(x, 2).Characters(y, 1).Font.ColorIndex = 1 Then
            Black = Black + 1
        End If

    Next y
    Cells(x, 3).FormulaR1C1 = "=1-" & Black & "/LEN(RC[-1])"

Next x

doneBox = MsgBox("Done!")

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic

edited Dec 09 '15 at 10:30

answered Dec 09 '15 at 10:25

Sergey Ryabov

656
1
8
19

Thanks for this. This is a lot faster, the main difference being the "=1" instead of "<>5" And "<>10". However I think there are ways of doing this a lot, lot quicker. Could you please refer to [Count keywords within phrases](http://stackoverflow.com/questions/32860792/count-keywords-within-phrases/32878493#32878493) which does something very similar but in a fraction of the time. Thanks – Simon Dec 09 '15 at 18:22
2

@Simon Jeeped's code is writing to multiple characters at once - this code by Sergey has to iterate character by character (as per Rory's comment above). It if improved your response you should accept it as the answer rather than ask Sergey to look at another question. – brettdj Dec 11 '15 at 03:44

Counting number of black characters in a sentence

1 Answers1