Macro stops partway through endnotes

[milk4140]

I'm using macros in Word 2013 to modify journal article manuscripts in preparation for converting into HTML. One of the macros takes all of the italics in the manuscript and surrounds them with <em> tags. The macro I'm currently using looks at the body text and the endnotes as distinct sections and this half works. My problem is that the macro will convert the italics in some, but not always all of the endnotes. In some manuscripts it will works on all of the endnotes, in some manuscripts it only works in about the first half of the endnotes, in some manuscripts in only works on the first few endnotes.

I've made sure that all of the Endnotes have the 'Endnote Text' style applied before I run the macro, so I don't think the problem is there. I'm currently looking at the underlying Word XML to try and determine if there's some difference there that might account for the issue.

If anyone has any ideas, I would greatly appreciate the help.

Thanks!

Current macro:

Sub html_italics()
'
'
'
Dim ThisRng As Range
If Selection.Type = wdSelectionNormal Then GoTo SelectionOnly
'
'do body text

Set ThisRng = ActiveDocument.StoryRanges(wdMainTextStory)


With ThisRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = ""
.Replacement.Text = "<em>^&</em>"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
ThisRng.Find.Execute Replace:=wdReplaceAll
End With
With ThisRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = " </em>"
.Replacement.Text = "</em> "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
ThisRng.Find.Execute Replace:=wdReplaceAll
End With
With ThisRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = "^p</em>"
.Replacement.Text = "</em>^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
ThisRng.Find.Execute Replace:=wdReplaceAll
End With
With ThisRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = ".</em>"
.Replacement.Text = "</em>."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
ThisRng.Find.Execute Replace:=wdReplaceAll
End With
With ThisRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = "<em></em>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
ThisRng.Find.Execute Replace:=wdReplaceAll
End With
'
'do endnotes if they're there
If existence_of_Endnotes = True Then
Set ThisRng = ActiveDocument.StoryRanges(wdEndnotesStory)
With ThisRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = ""
.Replacement.Text = "<em>^&</em>"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
ThisRng.Find.Execute Replace:=wdReplaceAll
End With
With ThisRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = " </em>"
.Replacement.Text = "</em> "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
ThisRng.Find.Execute Replace:=wdReplaceAll
End With
With ThisRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = "^p</em>"
.Replacement.Text = "</em>^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
ThisRng.Find.Execute Replace:=wdReplaceAll
End With
With ThisRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = ".</em>"
.Replacement.Text = "</em>."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
ThisRng.Find.Execute Replace:=wdReplaceAll
End With
With ThisRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = "<em></em>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
ThisRng.Find.Execute Replace:=wdReplaceAll
End With
End If
'
'this part does only the selected text
SelectionOnly:
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = ""
.Replacement.Text = "<em>^&</em>"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute Replace:=wdReplaceAll
End With
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = " </em>"
.Replacement.Text = "</em> "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute Replace:=wdReplaceAll
End With
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = "^p</em>"
.Replacement.Text = "</em>^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute Replace:=wdReplaceAll
End With
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = ".</em>"
.Replacement.Text = "</em>."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute Replace:=wdReplaceAll
End With
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Italic = True
.Replacement.Font.Italic = False
.Text = "<em></em>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute Replace:=wdReplaceAll
End With
GoTo FinalCleanup
FinalCleanup:
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
End With
End Sub