word macro crashes when 'while' loop is executed

Question

I have a VBA macro(Word2010) script to highlight all the text in italics. But when executed in large file say a document with more than 10 pages the Word get crashed. I have used the below code for this purpose.

Sub Italics_Highlight()
'
' test_italics_highlight_ Macro
'
'
    Application.ScreenUpdating = False
    Dim myString As Word.Range
    Set myString = ActiveDocument.Content
    With myString.Find
        .ClearFormatting
        .Text = ""
        .Font.Italic = True
        While .Execute
            myString.HighlightColorIndex = wdTurquoise
            myString.Collapse wdCollapseEnd
        Wend
    End With
    MsgBox "Thank you!"
End Sub

Could you please help to overcome this. Thanks for your help in advance.

Answer 1

You don't need to stop at each "found" and apply highlighting. You can do it as part of a Find/Replace:

Sub testInfiniteLoop()
    Dim myString As word.Range

    Set myString = ActiveDocument.content
    Options.DefaultHighlightColorIndex = wdTurquoise
    With myString.Find
      .ClearFormatting
      .Text = ""
      .Font.Italic = True
      .Replacement.Text = ""
      .Replacement.Highlight = wdTurquoise
      .wrap = wdFindStop 'stop at the end of the document
      .Execute Replace:=wdReplaceAll
    End With
End Sub

Answer 2

Your error description looks like your code is running forever and doesn't finish.

1. You might want to add a DoEvents inside your While loop to keep Word responsive while running the code.

   With myString.Find
       .ClearFormatting
       .Text = ""
       .Font.Italic = True
       While .Execute
           DoEvents 'keeps Word responsive
           myString.HighlightColorIndex = wdTurquoise
           myString.Collapse wdCollapseEnd
       Wend
   End With
   

2. I'm not sure if your code will ever stop. The loop might not stop at the end of the document but start again from beginning, and therefore always find something italic again and again, looping forever.

   So you might need to set the .Wrap = wdFindStop to stop at the end of the document.
   See Find.Wrap Property (Word).

   With myString.Find
       .ClearFormatting
       .Text = ""
       .Font.Italic = True
       .Wrap = wdFindStop 'stop at the end of the document
       While .Execute
           DoEvents 'keeps Word responsive
           myString.HighlightColorIndex = wdTurquoise
           myString.Collapse wdCollapseEnd
       Wend
   End With
   

Answer 3

The following code not only highlights but also restores whatever highlight settings were previously in force:

Sub Italics_Highlight()
Application.ScreenUpdating = False
Dim i As Long: i = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdTurquoise
With ActiveDocument.Content.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = ""
  .Replacement.Text = "^&"
  .Replacement.Highlight = True
  .Format = True
  .Font.Italic = True
  .Wrap = wdFindContinue
  .Execute Replace:=wdReplaceAll
End With
Options.DefaultHighlightColorIndex = i
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

As you can see, you also don't need:

Dim myString As Word.Range
Set myString = ActiveDocument.Content