Option Explicit
Sub ChangeUK()
Dim vFindText As Variant
Dim sReplaceText As String
Dim oRng As Range
Dim oSearch As Range
Dim oFound As Range
Dim i As Long
Dim sAsk As String
    vFindText = Array("UK", "U.K.")
    sReplaceText = "United Kingdom"
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(FindText:="\<AFF\>*\<\/AFF\>", MatchWildcards:=True)
            Set oSearch = oRng
            For i = 0 To UBound(vFindText)
                Set oFound = oSearch
                With oFound.Find
                    .ClearFormatting
                    .Replacement.ClearFormatting
                    Do While .Execute(FindText:=vFindText(i), _
                                      MatchWholeWord:=True, _
                                      MatchWildcards:=True, _
                                      Forward:=True, _
                                      Wrap:=wdFindStop) = True
                        oFound.Text = sReplaceText
                        oFound.Comments.Add oFound, "Country name changed. Please check"
                        oFound.Collapse wdCollapseEnd
                        If oFound.End >= oSearch.End Then Exit Do
                    Loop
                End With
            Next i
        Loop
    End With
lbl_Exit:
    Exit Sub
End Sub