В тексте, находящемся в Word, выделить цветом и подсчитать слова, содержащие не менее двух повторяющихся букв - VBA

Формулировка задачи:

В тексте, находящийся в word 2007, выделить цветом и подсчитать слова, содержащие не менее двух повторяющихся букв. Вот что у меня получилось:

Sub macros
Dim oWrd As Range
Dim parazit As String
Dim i, j As Long
parazit = ",.;:!?""'|/*+-=()[]{}_`~%^@" '???????-????????
For Each oWrd In Selection.Paragraphs(1).Range.Words
   If (InStr(parazit, RTrim(oWrd)) = 0) And (oWrd <> Chr(13)) Then
      oWrd.Select
      With Selection
        If Right(.Range, 1) = Chr(32) Then
          .MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
           Set oWrd = .Range
         End If
      End With
      For i = 1 To (Len(RTrim(oWrd)) - 1)
      char = Mid(oWrd, i, 1)
       For j = 2 To Len(RTrim(oWrd))
       char2 = Mid(oWrd, j, 1)
       If char = char2 Then
        oWrd.HighlightColorIndex = wdBlue
        Exit For
        Exit For
        Else
        oWrd.HighlightColorIndex = wdRed
       End If
       Next j
       Next i
   End If
Next oWrd
End Sub

Однако текст выделяется не правильно. Кто может помочь? Как еще вывести в отдельной строке укрупненным шрифтом число выделенных слов.

Решение задачи: «В тексте, находящемся в Word, выделить цветом и подсчитать слова, содержащие не менее двух повторяющихся букв»

textual
                            Листинг программы 
                        

                            Option Explicit
 
Sub bb()
Dim oWord As Object, s$, i&, j&
On Error GoTo err_col
For Each oWord In ActiveDocument.Range.Words
    With New Collection
        s = Trim$(Replace$(oWord.Text, Chr$(160), "")) '<<< Sasha_Smirnov
        For i = 1 To Len(s)
            .Add 0, Mid$(s, i, 1)
        Next
next_word:
    End With
Next
With ActiveDocument
    .Range.InsertParagraphAfter
    .Range.InsertAfter "Слов с повторяющимися буквами: " & j
    With .Paragraphs(.Paragraphs.Count).Range.Font
        .Size = .Size + 2
    End With
End With
Exit Sub
 
err_col:        'v не цеплять пробел после слова v
ActiveDocument.Range(oWord.Start, oWord.End + (Right$(oWord.Text, 1) = " ")) _
    .HighlightColorIndex = wdBrightGreen
j = j + 1
Resume next_word
End Sub
                        