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.
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.
Code:
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