VBA Add Bold Quotes Issue

I have put together a little macro that inserts quotes when bold text is selected. It works fine if you select the word(s) and the space after it but if the space is not selected then anything bold text above the selected text the macro is inserting quotes. How can I get the macro to only insert quotes without selecting the space for that selected text. I've added a test document so you can see what happens if, for example, you select just the word 'subsidiary' (without selecting the space) in the definition of Group Company. Any help would be very much appreciated. Thanks

Code:

---

Sub AddBoldQuotes()Application.ScreenUpdating = False
If Selection.Type = wdSelectionIP Then
 MsgBox Prompt:="You have not selected any text!"
 Exit Sub
End If
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = False
  .Wrap = wdFindStop
  .Format = True
  .MatchWildcards = False
    With Selection.Find
        .Text = ""
        .Font.Bold = True
        .Replacement.Text = """^&"""
        .Execute Replace:=wdReplaceAll
    End With
    Application.ScreenUpdating = True
  End With
End Sub

---