none
How to speed up changes in document using Selection.Find.Execute in W2010 RRS feed

  • Question

  • For example, in Word 2003 all changes in my macros: 20 seconds.
    In Word 2010: 80 seconds.

    And when I use sth. like this:

    With Selection.Find
    .Execute
    Do While .Found
    '(do sth.)
    .Execute
    Loop
    End with

    difference is bigger - in Word 2003 is 1s, in 2010 - 10s.

    May I turn off (in some magic way) highlighting founded text in all doc?

    I don't repeat finding settings (like Selection.Find.MatchCase = True) in loop, so it's not a problem.
    Thursday, November 19, 2015 1:48 PM

Answers

  • Thanks for every answers.
    I can not avoid loops (I have over 300 changes in every file, over 4000 files weekly) ...

    Last time I found dialog, where I can disable highlighting every founded text, but its not accelerate my macros.

    Even if you can't avoid looping, the amount of code required in the loops can be minimised. And, as for 'highlighting every founded text' that suggests you're still working with Selections instead of Range objects. As both Cindy and I have already said, that's very inefficient. The code I've posted already demonstrates how to avoid working with Selections. The following code demonstrates looping through a series of hard-coded Find/Replace expressions, again without resorting to Selections:

    Application.ScreenUpdating = False
    Dim StrFnd As String, StrRep As String, i As Long
    StrFnd = "One,Two,Three"
    StrRep = "Four,Five,Six"
    With ActiveDocument.Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .MatchCase = True
      .MatchWholeWord = True
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      For i = 0 To UBound(Split(StrFnd, ","))
        .Text = Split(StrFnd, ",")(i)
        .Replacement.Text = Split(StrRep, ",")(i)
        .Execute Replace:=wdReplaceAll
      Next
    End With
    Application.ScreenUpdating = True

    Note how little of the code needs to be contained in the loop. Minimising the number of functions that have to be called in a loop improves your code's efficiency.

    Instead of hard-coding the Find & Replace expressions in the code, an external source, such as a table in a document or an Excel workbook could be used. Furthermore, if you have multiple files to update at the same time, it's quite easy to loop through all documents in a selected folder. But, unless you say exactly what your requirements are, all you leave anyone here with is a guessing game.

    For a demonstration of an external Excel source for the Find & Replace expressions coupled with looping through all documents in a selected folder, see:  http://www.msofficeforums.com/word-vba/12803-find-replace.html#post34254. A slight addition to that code would enable the processing of headers & footers also.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by David_JunFeng Wednesday, December 2, 2015 9:01 AM
    Tuesday, November 24, 2015 11:56 AM

All replies

  • With each subsequent release of Word in the new file format, automation execution has slowed, sometimes tremendously. It's unlikely you'll get performance back up to 2003 standards.

    That said, you can try using Range.Find instead of Selection.Find. That should be faster and it does NOT display in the UI:

       Dim rngFind as Word.Range
       Set rngFind = ActiveDocument.Content
       With rngFind.Find
          'and so on


    Cindy Meister, Office Developer/Word MVP, <a href="http://blogs.msmvps.com/wordmeister"> my blog</a>

    Friday, November 20, 2015 5:19 PM
    Moderator
  • You should avoid using loops with Find/Replace except where absolutely necessary. For example:

    Application.ScreenUpdating = False
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "Find Text"
        .Replacement.Text = "Replace text"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
      End With
    End With
    Application.ScreenUpdating = True

    Where necessary, turning off ScreenUpdating accelerates the process, as does avoiding the use of Selections. For example:

    Application.ScreenUpdating = False
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "Find Text"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
      End With
      Do While .Find.Found
        .Words.First.Font.Bold = True
        .Words.Last.Font.Bold = False
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
    Application.ScreenUpdating = True


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Friday, November 20, 2015 9:19 PM
  • Thanks for every answers.
    I can not avoid loops (I have over 300 changes in every file, over 4000 files weekly) I'm using .ScreenUpdating all the time. 
    I've even tried hide window, but I skip that solution, because blinking window was confusing for users.

    Last time I found dialog, where I can disable highlighting every founded text, but its not accelerate my macros.

    Its very annoying that macros need so much time (worst than 13 years ago with :-)

    Sorry for my english - it's not my native.
    Tuesday, November 24, 2015 10:42 AM
  • Thanks for every answers.
    I can not avoid loops (I have over 300 changes in every file, over 4000 files weekly) ...

    Last time I found dialog, where I can disable highlighting every founded text, but its not accelerate my macros.

    Even if you can't avoid looping, the amount of code required in the loops can be minimised. And, as for 'highlighting every founded text' that suggests you're still working with Selections instead of Range objects. As both Cindy and I have already said, that's very inefficient. The code I've posted already demonstrates how to avoid working with Selections. The following code demonstrates looping through a series of hard-coded Find/Replace expressions, again without resorting to Selections:

    Application.ScreenUpdating = False
    Dim StrFnd As String, StrRep As String, i As Long
    StrFnd = "One,Two,Three"
    StrRep = "Four,Five,Six"
    With ActiveDocument.Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .MatchCase = True
      .MatchWholeWord = True
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      For i = 0 To UBound(Split(StrFnd, ","))
        .Text = Split(StrFnd, ",")(i)
        .Replacement.Text = Split(StrRep, ",")(i)
        .Execute Replace:=wdReplaceAll
      Next
    End With
    Application.ScreenUpdating = True

    Note how little of the code needs to be contained in the loop. Minimising the number of functions that have to be called in a loop improves your code's efficiency.

    Instead of hard-coding the Find & Replace expressions in the code, an external source, such as a table in a document or an Excel workbook could be used. Furthermore, if you have multiple files to update at the same time, it's quite easy to loop through all documents in a selected folder. But, unless you say exactly what your requirements are, all you leave anyone here with is a guessing game.

    For a demonstration of an external Excel source for the Find & Replace expressions coupled with looping through all documents in a selected folder, see:  http://www.msofficeforums.com/word-vba/12803-find-replace.html#post34254. A slight addition to that code would enable the processing of headers & footers also.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by David_JunFeng Wednesday, December 2, 2015 9:01 AM
    Tuesday, November 24, 2015 11:56 AM
  • I know it is a little bit different question that in first post but it is connected with Word .Find efficiency.
    Is it possible to use range.find (instead of Selection.Find) not only for replace?

    For example: I'd like to add to array (Dim boldArray() as Range) every bolded text. Now I'm doing sth. like this:

    Save all bolded text in range array, .ClearFormatting and get back bold on every range from array.

    Private Sub Test()
        Dim rStory As Range
        Dim boldArray() As Range
        Dim mr As Range
        Dim i As Long
        
        Application.ScreenUpdating = False
        Selection.Find.ClearFormatting
        Selection.Find.Font.Bold = True
        
        For Each rStory In ActiveDocument.StoryRanges
            If rStory.StoryType = wdMainTextStory Or _
                rStory.StoryType = wdFootnotesStory Or _
                rStory.StoryType = wdEndnotesStory Then
    
                rStory.Select
                With Selection
                    .HomeKey wdStory
                    .Find.Execute FindText:=vbNullString, Format:=True
    
                    Do While .Find.Found And Len(.Range.Text) > 0
                        Set mr = .Range
                        
                        'I know that for big data dynamic array could be a problem
                        'but in my files there is less then 100 bold
                        If Not Not boldArray Then
                            ReDim Preserve boldArray(0 To UBound(boldArray) + 1)
                        Else
                            ReDim boldArray(0 To 0)
                        End If
                        Set boldArray(UBound(boldArray)) = mr
                        .Find.Execute
                    Loop
                    rStory.Select
                    .ClearFormatting
                    ActiveDocument.UndoClear
                    .HomeKey wdStory
                End With
                
                If Not Not boldArray Then '==true only if there is sth in array
                    For i = LBound(boldArray) To UBound(boldArray)
                        boldArray(i).Bold = True
                        ActiveDocument.UndoClear
                    Next i
                End If
                
                Erase boldArray
            End If
        Next rStory
    
        Application.ScreenUpdating = False
        Application.ScreenRefresh
    
    End Sub

                                                        
    Tuesday, December 8, 2015 12:32 PM
  • I really can't see what the point of all this back & forth is. Your last post demonstrates that you're ignoring the advice you've been given multiple times re Selection vs Range.

    I also can't see the point of looping through the document once to find bold content, add the ranges to an array, then looping through the array to do something, when the lot could be done in a single pass - possibly without even needing a loop. Very inefficient.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Tuesday, December 8, 2015 10:33 PM
  • Thanks Paul, I know that this code looks... stupid. But I have files where this is necessery - Selection.ClearFormatting remove all trash from text. I have a lot of files from many sources (lot of publishers in many file formats from differents platforms) and I consolidate them (I'm working only with rtf files).
    Selection.ClearFormatting clean text perfectyly, but some kind of formatting is necessary (bold in this case).

    Next, this files are converted to xml (but not using .SaveAs) - I've converter from rtf code to xml, and this code has to be clean.

    Perhaps I have been doing sth like this to long and I can't focus on differen solutions. Sorry for dissapointing you, Paul.
    Wednesday, December 9, 2015 9:51 AM
  • To retain bold formatting and remove all other formatting probably requires nothing more complicated than:

    Application.ScreenUpdating = False
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ""
        .Replacement.Text = ""
        .Format = True
        .Forward = True
        .Font.Bold = False
        .Wrap = wdFindStop
        .Execute
      End With
      Do While .Find.Found
        .Font.Reset
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
    Application.ScreenUpdating = True

    Once again, there is no need to select anything!

    Additional code might be required if you have bold italics and only want to keep the bold, for example, but there is still no need to build range arrays and the like prior to the processing. Rather, you might use code like:

    Application.ScreenUpdating = False
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Format = True
        .Font.Italic = True
        .Font.Bold = True
        .Replacement.Font.Italic = False
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
        .Font.Bold = False
        .Wrap = wdFindStop
        .Execute
      End With
      Do While .Find.Found
        .Font.Reset
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
    Application.ScreenUpdating = True

    Indeed, you can do a lot of reformatting very quickly without using Find/Replace, either. For example:

    Application.ScreenUpdating = False
    With ActiveDocument.Range.Font
      .Italic = False
      .Underline = wdUnderlineNone
      .ColorIndex = wdBlack
      .Name = Arial
      .Shading.BackgroundPatternColorIndex = wdNoHighlight
    End With
    Application.ScreenUpdating = True


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Thursday, December 10, 2015 2:02 AM Added comments about reformatting without using Find/Replace
    Wednesday, December 9, 2015 11:49 AM