Macro for Find/replace to remove space before Hard Return

[AlfredStreich]

I have been trying to set up a Word Macro to remove a space before a hard return. I am able to get it to work on the main text properly, but when I added lines to apply it to the footnotes, it doesn't work properly. Instead of just removing the space it removes the space and then after the hard return, it adds a space and a hard return. I can't figure out how to tweak the text of the macro to resolve this. Here is the macro I am trying to use:
Sub SpaceBeforeHardReturn()


'
' SpaceBeforeHardReturn Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Set Footnotes = ActiveDocument.StoryRanges(wdFootnotesStory)
Footnotes.Find.ClearFormatting
Footnotes.Find.Replacement.ClearFormatting
With Footnotes.Find
.Text = " ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Footnotes.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
End Sub

Thanks for any advice.