Sub FindRedcoloredText()
    Dim i As Long
    Dim oRng As Range
    i = 0
    Set oRng = ActiveDocument.Range
    Application.ScreenUpdating = False
    With oRng.Find
        .Font.color = wdColorRed
        Do While .Execute(Forward:=True)
            i = i + 1
            Debug.Print CStr(i) + ". " & _
                        oRng.text + " " & _
                        CStr(oRng.Information(wdActiveEndPageNumber))
            DoEvents
        Loop
    End With
    Application.ScreenUpdating = True
End Sub