word vba range not repositioning using a loop

I am working on a macro in word. It pulls cell contents from some cells in an excel doc, puts part of them at the end of the word doc, bolds the first part, then puts the rest of the string and unbolds it.Then it looks for the next match in the excel doc and repeats until there are no matches.

On the second pass through the loop, it continues to affect the content added in the first pass. The font with block also affects the previous line and ends up bolding the entire thing. I set the object to Nothing at the end of the function so I wouldn't expect it to see the first part of the loop as part of the range any longer.

     Do
         x = AssembleSentence(Last, First, Rank)
         Set Loc = .FindNext(Loc)
     Loop While Not Loc Is Nothing And Loc.Address <> sFirstFind

Function AssembleSentence(Last, First, Rank)
    Dim sText0 As String, sText As String, oText As Object
    Set oText = ActiveDocument.Content
    sText0 = First & " " & Last
    sText = ", " & Rank & " Professor at College of Hard Knocks."

    Set oText = ActiveDocument.Content.Paragraphs.Add
    oText.Range.SetRange Start:=ActiveDocument.Range.End, End:=ActiveDocument.Range.End
    Selection.EndKey Unit:=wdStory

    With oText.Range
        .InsertAfter (sText0)
        With .Font
            .Bold = True
        End With
    End With

    Selection.EndKey Unit:=wdStory

    With Selection
        .Text = sText
        With .Font
            .Bold = False
        End With
    End With

    Selection.EndKey Unit:=wdStory

    Set oText = Nothing

End Function

Solution

Still unsure why the loop doesn't redo the range to the end on its own, but this fixes it so that it stops affecting prior looped content.

Looking at my oText.range start/end properties it looks like it is 1034/1035 with a length of 1036 on the first pass and then 1036/1209 with a length of 1210 on the second pass. That is the issue - I don't know why it isn't 1208/1209 on the second pass after setting the object to nothing at the end of the first pass, but the following edit fixes the issue.

With oText.Range
    .SetRange Start:=oText.Range.End, End:=oText.Range.End
    .InsertAfter (sText0)
    With .Font
        .Bold = True
    End With
End With