VBA code to skip bullet items

[SOB]

Hello,

I have written a macro for MS Word to replace any instance of two paragraphs returns with one paragraph return. (Double paragraph returns cause problems later on in the production cycle at the publication I work for.) Here's the code:

Sub ReplaceDoubleReturnsWithSingleReturn()


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

While this code works in general, it has the following bug. If the last item of a bulleted list in the document is hyperlinked, running the macro causes that item to get deleted. I've attached a test document so that you can see what I mean. The highlighted word in the doc gets deleted after you run the macro.

Is it possible to add code that prevents the macro from replacing returns around bulleted text?

I'm only an amateur VBA user, and basically just pieced together bits of code I found online to make my macro. So not an expert here. Any help is much appreciated! Thanks.

====

Word for Mac 2011 - Version 14.5.1