Moving inline citations

[NoCalScribe]

I have a large file that has what I will call inline citations in some paragraphs, but not all.
They are all marked with START and END.
I would like to be able to search through the file, find and relocate each instance of the cite to
just below the paragraph it's located in (separated by a return). If there are multiple instances in a
paragraph, I would like them to appear one after the other below the paragraph.

Example:

Paragraph text START cite1 END more text START cite2 END more text until end of paragraph


to this:

Paragraph text

Cite1

Cite2


Would this be easier if the cites were treated as bookmarks?

Thanks all!

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, Rng As Range
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<START*END>"
.Replacement.Text = ""
.Forward = False
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
If Len(.Duplicate.Paragraphs.First.Range.Text) > (Len(.Text) + 1) Then
.Duplicate.Paragraphs.First.Range.InsertAfter vbCr
Set Rng = .Duplicate.Paragraphs.Last.Next.Range
Rng.Collapse wdCollapseStart
Rng.FormattedText = .Duplicate.FormattedText
i = i + 1
.Delete
End If
.Collapse wdCollapseStart
.Find.Execute
Loop
With .Find
.Wrap = wdFindContinue
.MatchWildcards = True
.Text = "<START (*) END>"
.Replacement.Text = "\1"
.Execute Replace:=wdReplaceAll
.Text = "<START(*) END>"
.Execute Replace:=wdReplaceAll
.Text = "<START (*)END>"
.Execute Replace:=wdReplaceAll
.Text = "<START(*)END>"
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
MsgBox i & " citations relocated."
End Sub

[NoCalScribe]

That puts them where I want them - thanks, Paul!