Sub WillGenderChange21April()
'
' WillGenderChange21April Macro
Dim SavedTexts As Object
Dim rng As Range
Set rng = Selection.Range

Selection.HomeKey Unit:=wdStory  
    Selection.GoTo What:=wdGoToBookmark, Name:="Husband"
    SelectNameForWillSubSub  'This calls sub SelectNameForWillSubSub
    
    
    ' Move to a new location
    Selection.GoTo What:=wdGoToBookmark, Name:="Wife"
    If SavedTexts.Exists(Husband) Then
        Selection.FormattedText = SavedTexts(Husband).FormattedText 
   
    
    'SelectNameForWillSubSub  'This calls sub
    ' Insert the stored text at the new location
    Selection.TypeText Husband 'UserSelection

 
'It works to here to select the full name. Now to assign
'the selection to a variable and then delete it

End Sub

Sub SelectNameForWillSubSub()
'' SelectNameForWillSubSub Macro
'
Dim rng As Range
Set rng = Selection.Range
Dim selectedText As String
'SetSavedTexts = CreateObject("Scripting.Dictionary")
With rng.Find
        .ClearFormatting
        .Font.Bold = True
        .MatchCase = True
        .Text = "[A-Z]{1,}"
        .MatchWildcards = True
        .Execute
    End With

    ' If bold uppercase text is found, extend selection
    If rng.Find.Found Then
        Do While rng.Characters.Last.Font.Bold = True And _
                 rng.Characters.Last.Text Like "[A-Z ]" ' Allow spaces
            rng.MoveEnd wdCharacter, 1
        Loop
    End If

    ' Retract selection if a lowercase character was picked up
    If rng.Characters.Last.Text Like "[a-z]" Then
        rng.MoveEnd wdCharacter, -1
    End If
    rng.Select
  
End Sub