Finding text and marking text that DOES NOT EQUAL a certain value

Question

I have a VBA script that I use to run across a word document to highlight any text that doesn't meet certain criteria. The problem is its too slow on large documents. This is the script:

Sub MarkManualFontFormatting()

On Error GoTo ErrorHandler

Dim objRange As Range

If Documents.Count > 0 Then

If vbOK = MsgBox("Please ensure this document is a copy and NOT the original/master document." & vbNewLine & vbNewLine & _

"Press CANCEL if you don't wish to continue.", vbExclamation + vbOKCancel, "Mark Manual Font Formatting - WARNING :") Then

'Disable screen updating to improve speed.

Application.ScreenUpdating = False

'Examine each word in the document and conditionally apply lavender shading.

For Each objRange In ActiveDocument.Range.Words

With objRange.Font

If .Name <> "Minion Pro" Then

.Shading.BackgroundPatternColor = wdColorLavender

ElseIf .Size <> 12.5 Then

.Shading.BackgroundPatternColor = wdColorLavender

ElseIf objRange.Font.Color = wdColorBlack Then

.Shading.BackgroundPatternColor = wdColorLavender

ElseIf objRange.Font.Color = -587137025 Then

.Shading.BackgroundPatternColor = wdColorLavender

End If

End With

Next objRange

MsgBox "Script has completed", vbOKOnly + vbInformation

End If

Else

MsgBox "Please open a document before using this command.", vbOKOnly + vbInformation

End If

ErrorHandler:

'Be sure to re-enable screen updating.

Word.Application.ScreenUpdating = True

Set objRange = Nothing

Select Case Err.Number

Case 0

Case Else

MsgBox Err.Description, vbExclamation + vbOKOnly, "Unexpected"

Error ""

End Select

End Sub

I have looked at instructions for optimising the code to run as quickly as possible and I think it is about as good as I can get it? I think the slowness is because it has to loop through every word in the document. I'm wondering if maybe I need to approach it differently to speed it up? Most of the words in the document will end up not needing to be highlighted. Therefore I'm thinking maybe it would be faster to search for text that meet the above criteria (rather than not meet it) and then using selection.start and .end markers to capture the range of any text outside the search results and then apply a highlight to these ranges??? I'm not sure if this would be faster or not, and not sure how I would do it???  Any thoughts?

Many thanks. HJ

Answer 1

Thanks everyone for the great responses. 

I ended up doing a combination of John and Daniel's responses. Basically I applied a highlight to all the text and then used find/replace to remove the highlight from the text that matched the criteria. This meant I could then search through each highlight and it showed what didn't meet the criteria. This method is SO MUCH FASTER - can do 400 page documents in under 30 seconds while the old script choked on documents this big and took 15 minutes or more even on shortish documents.

I'll put a longer post up when I have a bit more time to give you some more background in case it's helpful to anyone else or if you think there's anything I could do differently. Basically its part of a couple of scripts I run over documents when I get then to show any manual formatting that has been applied ie. I want everything fully styled using character and paragraph styles so i need to identify up front any text that isn't.

Thanks again. HJ

Answer 2

Look at it from the opposite side:

• Apply the lavender background to the complete document
• Take it off from the places you don't want it (Minion Pro, 12.5 pts, color is not -587137025)

As such, you can do a single global replacement:

Sub MarkManualFontFormattinGlobal()

Selection.WholeStory

Selection.Font.Shading.BackgroundPatternColor = wdColorLavender

Selection.HomeKey UNIT:=wdStory

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

Selection.Find.Replacement.Highlight = False

With Selection.Find

.Text = ""

.Replacement.Text = ""

'.Replacement.Font.Shading.BackgroundPatternColor = wdColorAutomatic

.Forward = True

.Wrap = wdFindContinue

.Format = True

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

.Font.Name = "Minion Pro"

.Font.Size = 12.5

'.Execute Replace:=wdReplaceAll

.Execute

While .Found

Selection.Font.Shading.BackgroundPatternColor = wdColorAutomatic

Selection.Collapse Direction:=wdCollapseEnd

.Execute

Wend

End With

End Sub

Note two commented-out lines. I tried to replace the background in a global operation, but Word wouldn't take it, so I had to resort to the Selection object, and proceed one by one (the While .Found loop).

Your logic for applying the lavender background is unclear to me. The above code currently ignores the fact that you are not applying lavender if the color is not -587137025. Should you want to add this condition, then do a second replacement to any text with that color.

Answer 3

In addition to what John has suggested you might try this code and compare its speed.  You'll have to replace the "Debug.Print" commands with your conditional check for fontname and action.

Sub FindFonts()

    Dim done As Boolean

    Dim i As Integer

    Dim fontName As String

    Word.Selection.HomeKey unit:=Word.WdUnits.wdStory

    On Error Resume Next

    For i = 0 To Word.FontNames.count

        done = False

        Word.Selection.Find.ClearFormatting

        Word.Selection.Find.Font.Name = Word.FontNames(i)

        If Err.Number = 0 Then

            Do While Not done

               With Word.Selection.Find

                    .Format = True

                    .Forward = True

                    .Wrap = wdFindStop

                    .Text = ""

                    .Execute

                End With

                If Word.Selection.Find.Found Then

                    Debug.Print Word.FontNames(i) 'Replace with condition statement

                    Debug.Print Word.Selection.Text

                    Word.Selection.Collapse Word.WdCollapseDirection.wdCollapseEnd

                    If Word.Selection.Font.Name = Word.FontNames(i) Then

                        If Word.Selection.Range.Start = Word.ActiveDocument.Content.End - 1 Then

                            'handles the last paragraph mark in the document

                            done = True

                            Word.Selection.HomeKey unit:=Word.WdUnits.wdStory

                        Else

                            'necessary for individual words in a paragraph that are assigned a different font

                            Word.Selection.MoveRight unit:=Word.WdUnits.wdCharacter, count:=1

                        End If

                    End If

                Else

                    done = True

                    Word.Selection.HomeKey unit:=Word.WdUnits.wdStory

                End If

            Loop

        Else

            Err.Clear

            done = True

        End If

    Next

End Sub

Answer 4

I'll make several remarks, and then you can take your pick of what works for you :-)

Yes, doing a "For Each" on every word or every character in a document will be woundingly slow, because you need to redefine the range each time.

Generally for text-based operations you will find that the Range object is a lot slower than the Selection object, and I don't know why.  I accused the developer who wrote it of sliding some inline assembler in there, but he denied it on a stack of bibles :-)

If you were to recast your algorithm using the Selection object and the Find object, I thing you will find it will be quicker: maybe twice as quick.

You COULD try a "For Each PARAGRAPH in Document..."

Then conduct your search just within the paragraph range.  Yes, I know it makes the code twice as convoluted.  But since Word automatically maintains a Paragraph collection and a range for each paragraph, that may be dramatically faster.

However, I would never approach the production of a large document using Direct Formatting.  That way lies insanity and death.  I use styles for all formatting.  Then to find out if anyone has been playing, I turn the Normal style shocking pink (after making sure that the wanted styles are not based on Normal...).  Anything that has not been formatted with the approved styles then turns shocking pink and stands out like a dog's family jewels.

To ensure that nobody has been playing with the approved styles, I simple Select All and Reset Font, then Reset Para.  These commands are in the All Commands list in customise: usually they are Command + Shift + z, and Command + Option + q.  The combination instantly reverts text to the properties of the applied style.

To ensure nobody has been playing with the style definitions, simply re-attach the template and choose Update styles on open (then immediately deselect Update styles on open...)

There are some limitations: Command + Shift + z will remove ALL directly-applied character formatting, including bold and italic.  You can run a Find/Replace to add control characters each side of the bold or italic so you can automatically replace them later.

Alternatively, you could use the Find method to find all the correctly-formatted text and apply a style to that.  You could then set the font of that style to invisible: anything that then remains on the screen has something wrong with it.

I am afraid that's the best I can think of.  Sadly, "word" and "character" operations are very slow, because Word does not maintain internal collections for those, it has to rebuild them each time.

Hope this helps