title: Macro (VBA) crashing Microsoft word (Find and replace)
body: <p>I using a VBA code to batch find and replace highlighted text. The macro finds and replaces the words in the document. It works well with a few number of highlighted text on a small document (1-2 pages). However, when I use this macro on a large documents which has over a 100 pages, Microsoft word crashed and becomes unresponsive so I have to forced to quit.</p>
  <p>The code is to help make it easy to redact information. I am replacing the highlight text which occur also in tables with XXXXX and highlighted black.</p>
  <p>Does anyone have any tips to make the code more efficient?</p>
  <p>Here is the code</p>
  <pre><code>Sub FindandReplaceHighlight()
    Dim strFindColor As String
    Dim strReplaceColor As String
    Dim strText As String
    Dim objDoc As Document
    Dim objRange As Range
   
    Application.ScreenUpdating = False
   
    Set objDoc = ActiveDocument
   
    strFindColor = InputBox(&quot;Specify a color (enter the value):&quot;, &quot;Specify Highlight Color&quot;)
    strReplaceColor = InputBox(&quot;Specify a new color (enter the value):&quot;, &quot;New Highlight Color&quot;)
    strText = InputBox(&quot;Specify a new text (enter the value):&quot;, &quot;New Text&quot;)
    
    With Selection
      .HomeKey Unit:=wdStory
      With Selection.Find
        .Highlight = True
   
        Do While .Execute
          If Selection.Range.HighlightColorIndex = strFindColor Then
            Set objRange = Selection.Range
            objRange.HighlightColorIndex = strReplaceColor
            objRange.Text = strText
            objRange.Font.ColorIndex = wdBlack
            Selection.Collapse wdCollapseEnd
          End If
        Loop
      End With
    End With
   
    Application.ScreenUpdating = True
  End Sub
  </code></pre>