VBorNotVB: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had. See your edited post.
Looping through every character in a document is slow and unnecessary - excruciatingly so when every character is unnecessarily selected. In any event, testing whether characters fall in ASCII range 0-127 says nothing about whether they're Unicode; they might also be characters that fall in ASCII range 128-255!
Instead, try something based on:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[^1-^255]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
i = Len(.Range.Text) - .InlineShapes.Count
.Undo
End With
If i > 1 Then
MsgBox "Document contains Unicode characters."
Else
MsgBox "Document contains only ASCII characters."
End If
Application.ScreenUpdating = True
End Sub