Tell me more ×
Stack Overflow is a question and answer site for professional and enthusiast programmers. It's 100% free, no registration required.
up vote 1 down vote favorite

I have a word macro that counts all text in a document that is either highlighted or Un-underlined bold. The macro works fine - although the counts are slightly higher than what the "Find" feature returns on some documents (if anyone knows why I'd be excited to figure it out).

The issue with the macro is that it is remarkably inefficient and lags my computer for a non-trivial amount of time when running on documents of around 50 pages in length. Does anyone see a more efficient way to write a macro of similar functionality?

Dim highlightCount
Dim boldCount
Dim wordTotal
boldCount = 0
highlightCount = 0

For Each w In ActiveDocument.Words
    If w.HighlightColorIndex <> wdNoHighlight Then
     highlightCount = highlightCount + 1
    End If
    If w.Font.Bold = True Then
    If w.HighlightColorIndex = wdNoHighlight Then
    If w.Font.Underline = False Then
     boldCount = boldCount + 1
    End If
    End If
    End If
    Next
wordTotal = highlightCount + boldCount
MsgBox ("There are " & wordTotal & " words to be spread")

End Sub
share|improve this question

1 Answer

up vote 1 down vote accepted

I can't answer your question about too high result of your counter as I can't see the problem within your code. But I can propose another solution where I used Find object which I guess would be much faster than your idea. The only problem is that you have to run 'searching' twice separately (two loops below) for both type of word conditions you defined. 

Sub CountWords()

Dim rngWords As Range
Set rngWords = ActiveDocument.Content
Dim boldCount As Long, highlightCount As Long
Dim wordTotal As Long

Do
With rngWords.Find
    .Highlight = True
    .Forward = True
    .Execute
End With
If rngWords.Find.Found = True Then
    highlightCount = highlightCount + rngWords.Words.Count
Else
    Exit Do
End If
Loop

Set rngWords = ActiveDocument.Content

Do
With rngWords.Find
    .Font.Bold = True
    .Highlight = False
    .Font.Underline = wdUnderlineNone
    .Forward = True
    .Execute
End With
If rngWords.Find.Found = True Then
    boldCount = boldCount + rngWords.Words.Count
Else
    Exit Do
End If
Loop

wordTotal = boldCount + highlightCount
MsgBox "There are " & wordTotal & " words to be spread"
End Sub

Can you pleas give us a clue if it's faster as I don't have 50 pages document for test.

share|improve this answer
This runs much faster but it doesn't return correct results. It counts the number of sections of highlighted text instead of the number of highlighted words. So if the phrase "my name is bill" was highlighted it would count those four words as merely one instance. Thanks for the quick reply though - I'll look more into using Find again because it is substantially more efficient. – user1505405 Mar 16 at 13:58
I made a quick edit that seems to work - it's still off by several hundred words but it seems to be counting something and take less than 1/4th of the time to run. Thanks so much for the help. 'boldCount = boldCount + rngWords.Words.Count' – user1505405 Mar 16 at 14:04
Yes, exactly your suggestion is fine which I added to the code above. Did you add it twice? For both highlightCount and boldCound... – KazJaw Mar 16 at 14:32
Yes, added it twice - I think I might start a separate question to ask about the miscounting issue since it's unrelated to the question title. Thanks so much for your help. – user1505405 Mar 16 at 14:42

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.