Sub subFindTextAndMoveItToEndOfTheSameParagraphAndUnderlineIt_03()

    ' Code canniablized from http://stackoverflow.com/questions/11733766/how-to-search-for-text-and-check-for-underline-in-vba-for-word
    Dim c As Range
    Dim fnd As String
    Dim strText As String
    Dim objRange01 As Range
    Dim objRange02 As Range
    Dim objRange03 As Range
    Dim LparaNo As Long
    Dim strParazText As String


    With ActiveDocument

        strText = "Falsification  45 C.F.R. �" & Chr(160) & "6891(a)(2):  "

        ' My objectives are: (1) to move strText from the beginning of various paragraphs, to the end of each paragraph where it appears,
        '    and thereafter, (2) to delete the ":" at the end of strText, and (3) to underline strText

        fnd = strText

        If fnd = "" Then Exit Sub

        Set c = ActiveDocument.Content

        c.Find.ClearFormatting
        c.Find.Replacement.ClearFormatting

        With c.Find
            .Text = fnd
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
        End With

        c.Find.Execute

        While c.Find.Found
            c.Select ' I am trying to select the text that was found

            Set objRange01 = c ' I am trying to set objRange01 = the text that was found, and selected
            Selection.EndOf Unit:=wdParagraph, Extend:=wdExtend ' I am extending the selection to include the entire paragraph
            Set objRange02 = Selection.Range 'The entire paragraph
            Set objRange03 = ActiveDocument.Range(Start:=0, End:=Selection.End) ' I am trying to set objRange02 = all text from
            '                                                                     '   beginning of doc thru objRange01.text
            LparaNo = objRange03.ComputeStatistics(wdStatisticParagraphs) + 1 ' I am trying to set LparaNo = the no. of paras in all
            '                                                                 '    text from beginning of doc thru the end of objRange02.
            '                  ' Alas, the number generated for "LparaNo" is incorrect. The paragraph number generated for "LparaNo"
            '                  '    is the number for a paragraph that appears 5 pages before objRange01.text

            MsgBox "Paragraph # " & LparaNo & "  [objRange01.Text = c = ]  " & Chr(34) & objRange01.Text & Chr(34) & vbCrLf & _
                    vbCrLf & objRange02.Text & vbCrLf & vbCrLf & _
                    ActiveDocument.Paragraphs(LparaNo - 2).Range.Text & vbCrLf & _
                    ActiveDocument.Paragraphs(LparaNo - 1).Range.Text & vbCrLf & _
                    ActiveDocument.Paragraphs(LparaNo).Range.Text & vbCrLf ' & _
'                    ActiveDocument.Paragraphs(LparaNo + 1).Text & vbCrLf & _
'                    ActiveDocument.Paragraphs(LparaNo + 2).Range.Text & vbCrLf '& _

            objRange01.Move Unit:=wdParagraph, Count:=1 ' I am trying unsuccessfully to move the selected text to the beginning
            '                                            '   of the next paragraph
            objRange01.Move Unit:=wdCharacter, Count:=-1 ' I am trying unsuccessfully to move the selected text from the beginning
            '                                            '   of the next paragraph, to the end of the preceding paragraph, i.e.,
            '                                            '   to the end of the selected text's paragraph of origin.
            c.Find.Execute

        Wend ' While c.Find.Found

    End With

End Sub 'subFindTextAndMoveItToEndOfTheSameParagraphAndUnderlineIt_03

Sub subFindTextAndMoveItToEndOfTheSameParagraphAndUnderlineIt()
Dim oRng As Range
Dim oRngParent As Range
Dim strText As String
  strText = "Falsification  45 C.F.R. ?" & Chr(160) & "6891(a)(2):  "
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .ClearFormatting
    .Text = strText
    .Forward = True
    .Wrap = wdFindStop
    While .Execute
      With oRng
        .Select 'Why do you need to select it?
        .Text = Trim(.Text)
        .Font.Underline = wdUnderlineSingle
        Set oRngParent = .Paragraphs(1).Range
        With oRngParent
          .Characters.Last.Previous.InsertAfter " "
          .MoveEnd wdCharacter, -1
          .Collapse wdCollapseEnd
        End With
        .Cut
        With oRngParent
          .Paste
          .Characters.Last.Delete
          .Start = oRngParent.Paragraphs(1).Range.Start
          .Characters.First.Case = wdUpperCase
        End With
        .Start = oRngParent.End
      End With
    Wend 
  End With
End Sub