macro fails on 2nd run

[freed59]

Hi All,

I have a longish userform macro in Word that highlights defined terms in legal documents in different colors depending on if they are defined more than once (in quotes), defined but not used, and then every instance of the term.

This all works perfectly on the first run of a document, however, if I run it again on a 2nd document, it jumps out of one of the loops and goes to the next phase of the routine, ending prematurely.

If I close and restart Word, it runs perfectly again, but fails on 2nd attempt. It appears to fail when changing from the main story to the footnote story (highlighted in red) below. This is just the bit of code where it fails - please let me know if anyone would like to see the whole thing.

Has anyone had a similar issue? Many thanks for any help!




With Selection
.HomeKey wdStory


'highlight all copies yellow

With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(FindText:=StrFind2, _
MatchCase:=False, MatchWholeWord:=False, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Set oRng = Selection.Range
oRng.HighlightColorIndex = wdYellow
i = i + 1
ActiveDocument.UndoClear
Loop

If ActiveDocument.Footnotes.Count >= 1 Then


ActiveDocument.StoryRanges(wdFootnotesStory).Select

Do While .Execute(FindText:=StrFind2, _
MatchCase:=False, MatchWholeWord:=False, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Set oRng = Selection.Range
oRng.HighlightColorIndex = wdYellow
i = i + 1
ActiveDocument.UndoClear
Loop
End If

ActiveDocument.StoryRanges(wdMainTextStory).Select

[SamT]

Try using a variable set to Active Document

Dim TheDoc as Object

'Near the top of your Code
Set TheDoc = ActiveDocument

Replace all other instances of "ActiveDocument" in code with "TheDoc"

[macropod]

To make that work reliably, one would also need to replace:

With Selection
.HomeKey wdStory
with:

With TheDoc

[freed59]

Try using a variable set to Active Document

Dim TheDoc as Object

'Near the top of your Code
Set TheDoc = ActiveDocument

Replace all other instances of "ActiveDocument" in code with "TheDoc"


Thank you - just tried it, but still having the same issue . . .

[macropod]

Unfortunately, you haven't posted enough of your code to diagnose the issue. Try something along the lines of:

Sub Demo()
Application.ScreenUpdating = False
Dim wdDoc As Document, StrFnd As String, i As Long
Set wdDoc = ActiveDocument
StrFnd = InputBox("Text to find")
If Trim(StrFnd) = "" Then Exit Sub
With wdDoc
i = i + Counter(StrFnd, .StoryRanges(wdMainTextStory))
i = i + Counter(StrFnd, .StoryRanges(wdFootnotesStory))
.UndoClear
End With
MsgBox i
Application.ScreenUpdating = True
End Sub


Function Counter(StrFnd As String, Rng As Range) As Long
Dim i As Long
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(FindText:=StrFnd, _
MatchCase:=False, MatchWholeWord:=False, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
.Parent.HighlightColorIndex = wdYellow
i = i + 1
Loop
End With
End With
Counter = i
End Function

[freed59]

Unfortunately, you haven't posted enough of your code to diagnose the issue.


Thanks so much for your assistance! The procedure is quite long, so not sure how much to post . . .

It finds a start quote, extends to the end quote, puts the term in a variable, and loops through every term in the document, first those in the main story, then starting again from the footnotes, if the term is defined there. It highlights if defined more than once (in quotes more than once - turquoise), each instance without quotes (yellow), and if defined, but not used (in quotes, but never used again - red).

The big question for me is why it would work correctly on any document once, even in documents 100's of pages long, but then require a fresh process of Word to run correctly a 2nd time.

[macropod]

Based on your description, try:

Option ExplicitDim StrTerms As String, i As Long, j As Long, bFnd As Boolean


Sub Demo()
Application.ScreenUpdating = False
Dim StrFnd As String
StrTerms = "|"
With ActiveDocument
Call GetTerms(.StoryRanges(wdMainTextStory))
If .Footnotes.Count > 0 Then Call GetTerms(.StoryRanges(wdFootnotesStory))
StrTerms = Replace(Replace(StrTerms, "“", ""), "”", "")
For i = UBound(Split(StrTerms, "|")) - 1 To 1 Step -1
j = 0: StrFnd = Split(StrTerms, "|")(i)
Call RngTag(.StoryRanges(wdMainTextStory), StrFnd)
If .Footnotes.Count > 0 Then Call RngTag(.StoryRanges(wdFootnotesStory), StrFnd)
If j = 0 Then
StrTerms = Replace(StrTerms, StrFnd & "|", "")
End If
Next
For i = 1 To UBound(Split(StrTerms, "|")) - 1
StrFnd = Split(StrTerms, "|")(i)
Call TermTag(.StoryRanges(wdMainTextStory), StrFnd)
If .Footnotes.Count > 0 Then
If bFnd = False Then Call TermTag(.StoryRanges(wdFootnotesStory), StrFnd)
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Sub GetTerms(Rng As Range)
Options.DefaultHighlightColorIndex = wdRed
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = True
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Text = """"
.Replacement.Text = "^&"
.Execute Replace:=wdReplaceAll
.Text = "“*”"
.Replacement.Text = "^&"
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
.Format = False
.Wrap = wdFindStop
End With
Do While .Find.Execute
If InStr(StrTerms, .Text) = 0 Then
StrTerms = StrTerms & .Text & "|"
Else
.HighlightColorIndex = wdTurquoise
End If
.Collapse wdCollapseEnd
Loop
End With
End Sub


Sub RngTag(Rng As Range, StrFnd As String)
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.MatchWildcards = True
.Text = "[!“]" & StrFnd & "[!”]"
.Wrap = wdFindStop
End With
Do While .Find.Execute
j = j + 1
.Start = .Start + 1
.End = .End - 1
.HighlightColorIndex = wdYellow
.Collapse wdCollapseEnd
Loop
End With
End Sub


Sub TermTag(Rng As Range, StrFnd As String)
bFnd = False
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.MatchWildcards = True
.Text = "“" & StrFnd & "”"
.Wrap = wdFindStop
.Execute
End With
If .Find.Found Then
.HighlightColorIndex = wdYellow
bFnd = True
End If
End With
End Sub

[freed59]

Based on your description, try:



Paul, sorry for the late response - been crazy at work . . . thank you so much for writing this, but I couldn't get it to run . . . my VBA skills are rudimentary, at best. Here's the whole code - I'll cut out the footnote section, which is basically the same, but starts in the footnotes, in case a term is defined there. Hope it's not too long!



Sub HighlightDefs()
HighlightWork1.Show vbModeless
End Sub


Private Sub cmdAll_Click()

'1. Highlight Defined Terms

Dim i As Integer
Dim j As Integer
Dim R1 As Integer
Dim R2 As Integer
Dim R3 As Integer
Dim r4 As Integer
Dim oRng As Word.Range
Dim oRng2 As Word.Range
Dim NumCharsBefore As Long, NumCharsAfter As Long, LengthsAreEqual As Boolean
Dim StrFind As String
Dim StrReplace As String
Dim StrReplace2 As String
Dim StrFind2 As String
Dim Length As Integer
Dim varText As String
Dim myRange As Range

Dim char As String
Dim myNum As Integer
Dim myNum2 As Integer
Dim myNum3 As Integer

Dim bSmtQt As Boolean


i = 0
j = 0
R1 = 0
R2 = 0
R3 = 0
r4 = 0

Dim nCount As Long
nCount = 0

ActiveDocument.UndoClear


On Error GoTo Out3

ActiveDocument.ActiveWindow.View.Type = wdPrintView


'Application.ScreenUpdating = False

'replace straight quotes with smart quotes

bSmtQt = Options.AutoFormatAsYouTypeReplaceQuotes
Options.AutoFormatAsYouTypeReplaceQuotes = True
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = """"
.Replacement.Text = """"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With



If ActiveDocument.Footnotes.Count >= 1 Then

ActiveDocument.StoryRanges(wdFootnotesStory).Select


With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = """"
.Replacement.Text = """"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Options.AutoFormatAsYouTypeReplaceQuotes = bSmtQt


End If


With Selection
.HomeKey wdStory
End With

'find unmatched quotes

Dim oPara As Paragraph
For Each oPara In ActiveDocument.Paragraphs
With oPara.Range
If (Len(.Text) - Len(Replace(.Text, Chr(34), vbNullString))) Mod 2 <> 0 Then
.Select
MsgBox "Selected paragraph has unmatched plain quotes", vbExclamation

If varText = vbOK Then
Exit Sub
End If

Unload Me
Exit Sub
End If
If Len(Replace(.Text, Chr(147), vbNullString)) <> Len(Replace(.Text, Chr(148), vbNullString)) Then
.Select
MsgBox "Selected paragraph has unmatched smart quotes", vbExclamation

If varText = vbOK Then
Exit Sub
End If

Unload Me
Exit Sub
End If
End With
Next


Dim oFoot As Footnote
For Each oFoot In ActiveDocument.Footnotes
With oFoot.Range
If (Len(.Text) - Len(Replace(.Text, Chr(34), vbNullString))) Mod 2 <> 0 Then
.Select
MsgBox "Selected paragraph has unmatched plain quotes", vbExclamation

If varText = vbOK Then
Exit Sub
End If

Unload Me
Exit Sub
End If
If Len(Replace(.Text, Chr(147), vbNullString)) <> Len(Replace(.Text, Chr(148), vbNullString)) Then
.Select
MsgBox "Selected paragraph has unmatched smart quotes", vbExclamation

If varText = vbOK Then
Exit Sub
End If

Unload Me
Exit Sub
End If
End With
Next


ActiveDocument.UndoClear

i = 0

'insert text to mark end of replacements

Selection.HomeKey unit:=wdStory
Selection.TypeText Text:=Chr(147) & "xyxy" & Chr(148) & " "


Do

'A. find quote for next term

Selection.Find.ClearFormatting
With Selection.Find
.Text = "^0147"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

Set myRange = Selection.Range


If Selection.Range.HighlightColorIndex = wdTurquoise Then
With Selection.Find
.Text = "^0148"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

Selection.Find.ClearFormatting
With Selection.Find
.Text = "^0147"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Else
End If


'2. find close quote and select

Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^0148"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute


Selection.ExtendMode = False


StrFind = Selection.Text
StrReplace = Selection.Text
Length = Len(StrReplace) - 2


'set second variable for plural

If Length > 1 Then
StrFind2 = Mid$(StrReplace, 1, Length) & Chr(148)
StrReplace2 = Mid$(StrReplace, 1, Length) & Chr(148)
Else
End If

'skip certain words

If Mid$(StrFind, 2, 2) = "or" And Len(StrFind) = 4 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 3) = "or," And Len(StrFind) = 5 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 2) = "to" And Len(StrFind) = 4 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 3) = "to," And Len(StrFind) = 5 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Len(StrFind) = 3 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 3) = "and" And Len(StrFind) = 5 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 4) = "and," And Len(StrFind) = 6 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 3) = "our" And Len(StrFind) = 5 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 4) = "our," And Len(StrFind) = 6 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 2) = "we" And Len(StrFind) = 4 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 3) = "we," And Len(StrFind) = 5 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 2) = "us" And Len(StrFind) = 4 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If

If Mid$(StrFind, 2, 3) = "us," And Len(StrFind) = 5 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
End If



Set myRange = Selection.Range


'check if back at the beginning

If myRange = Chr(147) & "xyxy" & Chr(148) _
Or myRange = Chr(147) & "Xyxy" & Chr(148) _
Or myRange = Chr(147) & "XYXY" & Chr(148) Then
GoTo Skip3
Else
End If



'skip if string is too long

If Len(StrFind) > 254 Then
Selection.Collapse Direction:=wdCollapseEnd
GoTo Skip
Else
End If


With Selection
.HomeKey wdStory

'replace terms defined more than once

With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(FindText:=StrFind, _
MatchCase:=False, MatchWholeWord:=True, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Set oRng = Selection.Range
oRng.HighlightColorIndex = wdTurquoise
i = i + 1
ActiveDocument.UndoClear
Loop


Selection.HomeKey wdStory

Do While .Execute(FindText:=StrFind2, _
MatchCase:=False, MatchWholeWord:=True, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Set oRng2 = Selection.Range
oRng2.HighlightColorIndex = wdTurquoise
j = j + 1
ActiveDocument.UndoClear
Loop


If ActiveDocument.Footnotes.Count >= 1 Then

ActiveDocument.StoryRanges(wdFootnotesStory).Select

Selection.HomeKey

Do While .Execute(FindText:=StrFind, _
MatchCase:=False, MatchWholeWord:=True, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Set oRng = Selection.Range
oRng.HighlightColorIndex = wdTurquoise
i = i + 1
ActiveDocument.UndoClear
Loop

Selection.HomeKey

Do While .Execute(FindText:=StrFind2, _
MatchCase:=False, MatchWholeWord:=True, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Set oRng2 = Selection.Range
oRng2.HighlightColorIndex = wdTurquoise
j = j + 1
ActiveDocument.UndoClear
Loop
End If


ActiveDocument.StoryRanges(wdMainTextStory).Select

Selection.HomeKey


R1 = i
R3 = j

'remove highlighting if defined just once

If i > 0 And j > 0 Then

ElseIf i <= 1 And j = 0 Then
oRng.HighlightColorIndex = wdNone
ElseIf i = 0 And j <= 1 Then
oRng2.HighlightColorIndex = wdNone
Else
End If

End With
End With

i = 0
j = 0

'C. go back to last term

myRange.Select

Selection.MoveLeft unit:=wdCharacter, Count:=1


Selection.Find.ClearFormatting
With Selection.Find
.Text = "^0147"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute


Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^0148"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute


Selection.MoveLeft unit:=wdCharacter, Count:=1


Selection.ExtendMode = False


StrFind = Selection.Text
StrReplace = Selection.Text


'shorten selection by one character to handle plurals

If Len(StrReplace) > 3 Then
Length = Len(StrReplace) - 1
Else
Length = Len(StrReplace)
End If

StrFind2 = Mid$(StrReplace, 1, Length)
StrReplace2 = Mid$(StrReplace, 1, Length)

Set myRange = Selection.Range


With Selection
.HomeKey wdStory


'highlight all copies yellow

With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(FindText:=StrFind2, _
MatchCase:=False, MatchWholeWord:=False, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Set oRng = Selection.Range
oRng.HighlightColorIndex = wdYellow
i = i + 1
ActiveDocument.UndoClear
Loop

If ActiveDocument.Footnotes.Count >= 1 Then


ActiveDocument.StoryRanges(wdFootnotesStory).Select

Do While .Execute(FindText:=StrFind2, _
MatchCase:=False, MatchWholeWord:=False, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Set oRng = Selection.Range
oRng.HighlightColorIndex = wdYellow
i = i + 1
ActiveDocument.UndoClear
Loop
End If

ActiveDocument.StoryRanges(wdMainTextStory).Select

R2 = i

End With
End With



'check if term defined, but not used, and highlight red

If R2 = R1 + R3 Then

With Selection
.HomeKey wdStory

With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(FindText:=StrFind2, _
MatchCase:=False, MatchWholeWord:=False, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Set oRng = Selection.Range
oRng.HighlightColorIndex = wdRed
i = i + 1
ActiveDocument.UndoClear
Loop

If ActiveDocument.Footnotes.Count >= 1 Then

ActiveDocument.StoryRanges(wdFootnotesStory).Select

Selection.HomeKey

Do While .Execute(FindText:=StrFind2, _
MatchCase:=False, MatchWholeWord:=False, MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Set oRng = Selection.Range
oRng.HighlightColorIndex = wdRed
i = i + 1
ActiveDocument.UndoClear
Loop
End If


ActiveDocument.StoryRanges(wdMainTextStory).Select

End With
End With

End If


i = 0
R1 = 0
R2 = 0

myRange.Select


If myRange = Chr(147) & "xyxy" & Chr(148) _
Or myRange = Chr(147) & "Xyxy" & Chr(148) _
Or myRange = Chr(147) & "XYXY" & Chr(148) Then
GoTo Skip3
Else
End If


Selection.MoveRight unit:=wdCharacter, Count:=1

Skip:

ActiveDocument.UndoClear


Loop




Skip3:

'FOOTNOTE LOOP


SkipFootnote:



Set oRng = Nothing
Set oRng2 = Nothing
StrFind = vbNullString
StrReplace = vbNullString
StrReplace2 = vbNullString
StrFind2 = vbNullString
char = vbNullString


Call ClearFindAndReplaceParameters

Skip2:

'insert text box in header

Selection.HomeKey unit:=wdStory
Selection.MoveRight unit:=wdWord, Count:=3, Extend:=wdExtend
Selection.Delete unit:=wdCharacter, Count:=1

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 = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextbox(msoTextOrientationHorizontal, _
99#, 28.8, 144#, 171#).Select
Selection.ShapeRange.TextFrame.TextRange.Select
Selection.Collapse
Selection.TypeText Text:="cyan quotes = term defined more than once"
Selection.TypeParagraph
Selection.TypeText Text:="yellow = all instances of defined term"
Selection.TypeParagraph
Selection.TypeText Text:="red = term defined, but not used"
Selection.TypeParagraph
Selection.TypeText Text:="purple = possible undefined terms"
Selection.TypeParagraph
Selection.TypeText Text:="green = fields and selected references"

Selection.WholeStory
Selection.Font.Size = 8
Selection.ShapeRange.Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 53.5
Selection.ShapeRange.Width = 215.3
Selection.ShapeRange.Left = 99.35
Selection.ShapeRange.Top = 28.8
Selection.ShapeRange.TextFrame.MarginLeft = 7.2
Selection.ShapeRange.TextFrame.MarginRight = 7.2
Selection.ShapeRange.TextFrame.MarginTop = 1.44
Selection.ShapeRange.TextFrame.MarginBottom = 1.44
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionColumn
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionParagraph
Selection.ShapeRange.Left = InchesToPoints(0.13)
Selection.ShapeRange.Top = InchesToPoints(-0.1)
Selection.ShapeRange.LockAnchor = False
Selection.ShapeRange.LayoutInCell = True
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Selection.ShapeRange.WrapFormat.DistanceTop = InchesToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceBottom = InchesToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceLeft = InchesToPoints(0.13)
Selection.ShapeRange.WrapFormat.DistanceRight = InchesToPoints(0.13)
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.ZOrder 4
Selection.ShapeRange.TextFrame.AutoSize = False
Selection.ShapeRange.TextFrame.WordWrap = True
Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.SpaceAfter = 0

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument



Application.ScreenUpdating = True



ActiveDocument.UndoClear

Selection.Find.ClearFormatting
Call ClearFindAndReplaceParameters

Exit Sub
Out3:


End Sub

[macropod]

I couldn't get it to run
Getting it to 'run' is trivial - simply add it to a VBA module then click anywhere in it and press F5 - or run it from the GUI the same as might do for most macros.

[freed59]

Getting it to 'run' is trivial - simply add it to a VBA module then click anywhere in it and press F5 - or run it from the GUI the same as might do for most macros.

Understood, but it doesn't compile - I made some changes to get it to compile, but it nothing happens when run.

It's OK - I'll figure something out . . .

Thanks for your help.

[macropod]

I tested the code before posting it and it compiled and ran just fine... Your changes - whatever they were - are unlikely to have made it more likely to do either.

As for your own code, I don't have the time to pore over the 700+ lines you posted.

What I can say, though, is that it's extremely inefficient, with loads of Select and Selection references, view switching, and so on, none of which is necessary.

Some of the code also seems quite redundant. For example, having used Find/Replace to convert plain quotes to smart quotes, you then test for unmatched plain quotes. Both of those tests, by the way, have been taken from code I've posted elsewhere (e.g. https://www.msofficeforums.com/104926-post4.html)...