Consulting

Results 1 to 2 of 2

Thread: Find&Replace Macro is too slow

  1. #1

    Question Find&Replace Macro is too slow

    Hi all,

    I am using this Find & Replace macro which replaces words in a document, by getting the replacement words from another document. This macro works great on documents with 1-2 pages, but crashes the document if it is more than that. I'd like to use this on word documents with 15-20 pages (and possibly with a lot of replacements).

    Is there a way to slow down the macro, maybe run it in bits and pieces, or edit the code such that it doesn't crash?

    Any advice is appreciated! Thanks in advance.

    Sub ReplaceFromTableList()Dim oChanges As Document, oDoc As Document
    Dim oTable As Table
    Dim oRng As Range
    Dim rFindText As Range, rReplacement As Range
    Dim i As Long
    Dim y As Integer
    Dim sFname As String
    Dim sAsk As String
        sFname = "/Users/user/Desktop/testt.docx"
        Set oDoc = ActiveDocument
        Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
        Set oTable = oChanges.Tables(1)
        y = 0
        For i = 1 To oTable.Rows.Count
            Set oRng = oDoc.Range
            Set rFindText = oTable.Cell(i, 1).Range
            rFindText.End = rFindText.End - 1
            Set rReplacement = oTable.Cell(i, 2).Range
            rReplacement.End = rReplacement.End - 1
            
            For Each oRng In oDoc.StoryRanges
            With oRng.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                Do While .Execute(findText:=rFindText, _
                                  MatchWholeWord:=True, _
                                  MatchWildcards:=False, _
                                  Forward:=True, _
                                  Wrap:=wdFindStop) = True
                    
                    
                        oRng.FormattedText = rReplacement.FormattedText
                        y = y + 1
                Loop
            End With
            Next oRng
        Next i
        oChanges.Close wdDoNotSaveChanges
        MsgBox (y & " errors fixed")
    End Sub

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,093
    Location
    Cross-posted (and answered) at: https://stackoverflow.com/questions/...-replace-macro
    Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •