Hello,
I had a go at writing a macro that will look for a string in a long xml code (650,000 lines), will duplicate the paragraph the string is found in and will replace the string with another string in the original paragraph, and will do this till the end of the document.

This is fine with shorter pieces of xml to go through, but with the 650,000 lines, my Word 365 simply freezes, the macro seemingly not even starting. If I try it on 350,000 lines, the macro starts fine, but gets slower and slower, and like after 20 min Word freezes, too.

Is there a way the macro can be written to run faster? This is why I am asking for your help. Or would you have another idea how I get this done?
Thanks!


Public Const sTEXT = "k=""ABCD"""
Public Const sREPLACETEXT = "k=""EFGH"""

Sub Duplicate_And_Replace()
'Duplicates every paragraph (= line) with sTEXT and replaces sTEXT with sREPLACETEXT in the duplicate
    Dim lngSafety As Long
    Dim blnIsFound As Boolean
    On Error GoTo Error
    Selection.HomeKey Unit:=wdStory
    
    'Setting initial value for blnIsFound to make sure sTEXT does show up at all
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .TEXT = sTEXT
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    blnIsFound = Selection.Find.Execute                            'executes Find and sets blnIsFound to true or false
    
    lngSafety = 0
    Selection.HomeKey Unit:=wdStory
    While blnIsFound
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        blnIsFound = Selection.Find.Execute
'        MsgBox blnIsFound
        lngSafety = lngSafety + 1
'        If lngSafety > 8 Then
'            MsgBox lngSafety & " loops, probably infinite loop. Quitting."
'            Exit Sub
'        End If
        If blnIsFound Then
            CopyCurrentParagraph
            Selection.Collapse Direction:=wdCollapseStart
            Selection.PasteAndFormat (wdFormatOriginalFormatting)
            ReplaceTextInCurrentParagraph
        End If
    Wend
    MsgBox lngSafety & " loops"
    Err.Clear
Error:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Sub CopyCurrentParagraph()
    Selection.StartOf Unit:=wdParagraph
    Selection.MoveEnd Unit:=wdParagraph
    Selection.Copy
End Sub

Sub ReplaceTextInCurrentParagraph()
    Selection.StartOf Unit:=wdParagraph
    Selection.MoveEnd Unit:=wdParagraph
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .TEXT = sTEXT
        .Replacement.TEXT = sREPLACETEXT
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    With Selection
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
    End With
End Sub