Sub FindRedcoloredText()
Dim i As Long
Dim oRng As Range
    i = 0
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .Font.Color = wdColorRed
        Do While .Execute(Forward:=True)
            i = i + 1
            Debug.Print CStr(i) + ". " & _
                        oRng.Text + " " & _
                        CStr(Selection.Range.ComputeStatistics(wdStatisticPages))
            DoEvents
        Loop
    End With
lbl_Exit:
    Exit Sub
End Sub