Sub MarkIndexMacro()
Dim myRange As Range
    Set myRange = ActiveDocument.Range
    With myRange.Find
        .Text = ""
        .Font.ColorIndex = wdRed
        Do While .Execute
            ActiveDocument.Indexes.MarkEntry Range:=myRange, Entry:=myRange.Text
            myRange.Collapse 0
        Loop
    End With
    Set myRange = Nothing
End Sub