This might be faster didn't test:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng
.Collapse wdCollapseStart
Do
Do While .Characters.Last.Font.Name <> "Symbol" And .End <> ActiveDocument.Range.End
.MoveEnd wdCharacter, 1
Loop
.MoveEnd wdCharacter, -1
.Font.Name = "Arial"
.Collapse wdCollapseEnd
.MoveEnd wdCharacter, 1
Do While .Characters.Last.Font.Name = "Symbol" And .End <> ActiveDocument.Range.End
.MoveEnd wdCharacter, 1
.Select
Loop
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
Loop Until .End = ActiveDocument.Range.End - 1
End With
lbl_Exit:
Exit Sub
End Sub