This Macro takes 6 hours to run!!!

[jess.hutchinson]

Please help. This macro takes 4-6 hours to run (to be fair it is a fairly large document) and I am unsure how to optimize it. I added a line of code to not update the screen before hand (Application.ScreenUpdating = False at the beginning and Application.ScreenUpdating = True at the end) but it didn't seem to make a difference.
Purpose of Macro is to format random characters in the document.
The document that this is being run on is 2400 pages long. I expect it to take some time but it seems like it's slower every time. Another user takes 30 mins to run this one day and another day it's 6 hours on the same network.

Selection.HomeKey Unit:=wdStory
    'Selection.Find.ClearFormatting
    'Selection.Find.Replacement.ClearFormatting
    'With Selection.Find
        '.Text = "§" & vbTab
        '.Replacement.Text = ""
        '.Forward = True
        '.Wrap = wdFindStop
        '.Format = False
        '.MatchCase = False
        '.MatchWholeWord = False
        '.MatchWildcards = False
        '.MatchSoundsLike = False
        '.MatchAllWordForms = False
    'End With
    'Do While (Selection.Find.Execute)
    'Selection.MoveRight Unit:=wdCharacter, count:=1
    'With Selection.ParagraphFormat
        '.SpaceBefore = 0
        '.SpaceBeforeAuto = False
        '.SpaceAfter = 0
        '.SpaceAfterAuto = False
        '.LineSpacingRule = wdLineSpaceSingle
    'End With
    'Loop
Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "§"
        .Replacement.Text = "n"
        .Replacement.Font.Name = "Wingdings"
        .Replacement.Font.Size = 9
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "·"
        .Replacement.Text = "·"
        .Replacement.Font.Name = "Symbol"
        .Replacement.Font.Size = 12
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Size = 12
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Select "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Do While (Selection.Find.Execute)
        If Selection.Information(wdWithInTable) = True Then
            Set mySelection = Selection.Range
            mySelection.SetRange mySelection.Start, Selection.Cells(1).Range.End - 1
            mySelection.Select
            With Selection.ParagraphFormat
                .SpaceBefore = 0
                .SpaceBeforeAuto = False
                .SpaceAfter = 0
                .SpaceAfterAuto = False
                .LineSpacingRule = wdLineSpaceSingle
            End With
        End If
        Selection.MoveRight
    Loop
Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Verify "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Do While (Selection.Find.Execute)
        If Selection.Information(wdWithInTable) = True Then
            Set mySelection = Selection.Range
            mySelection.SetRange mySelection.Start, Selection.Cells(1).Range.End - 1
            mySelection.Select
            With Selection.ParagraphFormat
                .SpaceBefore = 0
                .SpaceBeforeAuto = False
                .SpaceAfter = 0
                .SpaceAfterAuto = False
                .LineSpacingRule = wdLineSpaceSingle
            End With
        End If
        Selection.MoveRight
    Loop
Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Font.Size = 12
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Size = 12
    With Selection.Find
        .Text = "•"
        .Replacement.Text = "·"
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
Selection.EndKey Unit:=wdStory
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    With Selection.PageSetup
 
        .HeaderDistance = InchesToPoints(0.2)
        .FooterDistance = InchesToPoints(0.2)

    End With
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With Selection.ParagraphFormat
       .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
    End With
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    With Selection.PageSetup
 
        .HeaderDistance = InchesToPoints(0.2)
        .FooterDistance = InchesToPoints(0.2)

    End With
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With Selection.ParagraphFormat
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
    End With
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Font.Name = "Symbol"
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Do While (Selection.Find.Execute)
    Selection.Font.Size = 12
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    With Selection.ParagraphFormat
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
    End With
    Loop
End Sub

[Arnoutdv]

This forum section is for VB6 programming.
I asked the moderators to move your question to the Office Development section.

Just a remark, please use code tags around your code.
Select the text and press the button with "#"

Also explain what parts of this macro are supposed to do.
And how big is a fairly large document?

[quickbbbb]

you should be upload your excel file

[jess.hutchinson]

Thanks! I am new here so this is helpful. Appreciate it.

[jess.hutchinson]

it's a 2400 page document so I won't be uploading it

[jess.hutchinson]

made those changes. thanks again!

[Arnoutdv]

2400 pages??!!
Wow, and you are modifying a lot, really a lot.
I wonder if it really can be made faster

You also have some blocks in which you replace "" with "" and only change the font.
Can you add comments to each block what it's supposed to do?

For me it seems you are looping multiple times thru the complete document to do single action.

And bare with me, I hardly have any experience with Office Macro's/Automation

[jdc2000]

Some questions:

1. How much memory does the computer(s) running this macro have installed and available? 4 GB of memory would not be the best for this task.

2. Where is the document that you are editing located? On a local hard drive or a network drive. If the document is on a network drive, that is going to significantly slow down the process.

3. How often do you have to run this macro? If it is a daily task, then speeding it up would be very helpful.

[jess.hutchinson]

Unfortunately, I do not have as much experience with Office Macros either. took me a couple months to get to this point. Yes you are correct. It's all simply finding extra spaces or odd characters and replacing it. 2400 pages was sadly not a personal choice haha!

[jess.hutchinson]

64 GB of memory. never had an issue with memory that I know of. Running on Local hard drive. I run it about once a week but only because it's so slow! I would love to run it more often.

[Arnoutdv]

Can't you split the document in smaller segments?
Is the source a Word document to start with?
If it's a normal text document then you could do a lot of the replacements on the text file first.

[jess.hutchinson]

sadly no. I have tried that but it makes more of a mess. and I export it out and it comes out as this one big document. The source is a Word document yes.

[jdc2000]

Sounds like a candidate for a Scheduled Task that runs the macro overnight.

[Arnoutdv]

sadly no. I have tried that but it makes more of a mess. and I export it out and it comes out as this one big document. The source is a Word document yes.

What kind of process do you have which directly write to such huge Word documents?

[westconn1]

i am sure it could be made faster by avoiding working with the selection object, but instead working with full qualified ranges