Sub Macro1()
Dim vFindText As Variant
Dim i As Integer
    vFindText = Array(ChrW(-3999), ChrW(-3998))
    For i = 0 To UBound(vFindText)
        Call FindSymbols(FindChar:=CStr(vFindText(i)), FindFont:="Symbol")
    Next i
End Sub

Sub FindSymbols(FindChar As String, FindFont As String)

Dim FoundFont As String, OriginalRange As Range, strFound As Boolean
    Application.ScreenUpdating = False
    Set OriginalRange = Selection.Range
    strFound = False
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = FindChar
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

        Do While .Execute    'Keep going until nothing found
            If Dialogs(wdDialogInsertSymbol).Font = FindFont Then
                strFound = True
                Selection.Font.Name = "Times New Roman"
                Selection.Font.Size = 14
            Else
                Selection.Collapse 0
            End If
            strFound = False
        Loop

        If Not strFound Then
            'if nothing found, search from the beginning of the document
            ActiveDocument.Range(0, 0).Select
            Do While .Execute
                If Dialogs(wdDialogInsertSymbol).Font = FindFont Then
                    Selection.Font.Name = "Times New Roman"
                    Selection.Font.Size = 14
                    strFound = True
                Else
                    Selection.Collapse 0
                End If
                strFound = False
            Loop
        End If

    End With

    OriginalRange.Select

    Set OriginalRange = Nothing
    Application.ScreenUpdating = True

End Sub