Need VBA Macro To Remove Paragraph Marks In Part Of A MS Word Doc

[DIHayman]

The Excel side of this site has been a great resource over the years. Now I have a problem for the MS Word VBA/Macro gurus.

I have an MS Word document, that is created daily by legacy software, that adds hard returns - represented in MS Word with the "^P" combination.

I need a VBA macro that will remove the hard returns ONLY in the "Description" section of the document.

I've attached a sample portion of the document as an image, showing the MS Word formatting. The actual document contains additional information, and can be hundreds of pages long, but the section that needs cleaning up is always the section between "Description" and "Additional Information"

Can anyone help?

[protonLeah]

Option Explicit
Sub RemoveHARDReturns()
    Dim DescriptionLine     As Long
    Dim AdditionalInfoLine  As Long
    
    'move cursor to top of document
    Selection.HomeKey _
        unit:=wdStory
        
    With Selection
        With .Find
            .Forward = True
            .ClearFormatting
            .Text = "Additional Information"
            .Wrap = wdFindContinue
            .Execute
        End With
        
        'get the line number of add'l info txt, move up one line
        AdditionalInfoLine = Selection.Range.Information(wdFirstCharacterLineNumber) - 1
        
        With .Find
            .Forward = True
            .ClearFormatting
            .Text = "Description"
            .Wrap = wdFindContinue
            .Execute
        End With
        
        'get line number
        DescriptionLine = Selection.Range.Information(wdFirstCharacterLineNumber)
    End With
    Debug.Print "desc: " & DescriptionLine, " add'l info: " & AdditionalInfoLine
    
    Selection.MoveDown _
        unit:=wdLine
    Selection.MoveDown _
        unit:=wdLine, _
        Count:=AdditionalInfoLine - DescriptionLine - 2, _
        Extend:=True
' replace ^p paragraph codes
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute _
        Replace:=wdReplaceAll
End Sub