'Test Remove Red Color
Sub RemoveRed() 
    Application.ScreenUpdating = False 
    Dim i As Long, Rng As Range, sVpos As Single 
    With ActiveDocument.Range 
        With .Find 
            .ClearFormatting 
            .Replacement.ClearFormatting 
            .Text = "Red" 
            .Replacement.Text = "" 
            .Forward = True 
            .Wrap = wdFindStop 
            .Format = False 
            .MatchCase = False 
            .MatchWholeWord = False 
            .MatchWildcards = False 
            .MatchSoundsLike = False 
            .MatchAllWordForms = False 
            .Execute 
        End With 
        Do While .Find.Found 
            i = .Duplicate.Information(wdActiveEndPageNumber) 
            Set Rng = ActiveDocument.GoTo(What:=wdGoToPage, Name:=i) 
            Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page") 
            sVpos = 0 
            With Rng 
                For i = 1 To .Frames.Count 
                    If InStr(1, .Frames(i).Range.Text, "Red", vbTextCompare) Then 
                        .Frames(i).RelativeVerticalPosition = wdRelativeVerticalPositionPage 
                        sVpos = .Frames(i).VerticalPosition - 4 
                        Exit For 
                    End If 
                Next 
                For i = .Frames.Count To 1 Step -1 
                    With .Frames(i) 
                        If .VerticalPosition > (sVpos) Then 
                            If .VerticalPosition < (sVpos + 36) Then 
                                .Cut 
                            End If 
                        End If 
                    End With 
                Next 
            End With 
            .Collapse wdCollapseEnd 
            .Find.Execute 
        Loop 
    End With 
    Application.ScreenUpdating = True 
End Sub