Hello,
I have a macro where it will remove all colors that are Red and any data of it and will not include the next different color and their data. The problem lately I'm noticing that the macro is also removing the next color after Red and some of its data. Can you please check what I've missed on this? Here is the print screen (I don't know how to upload the word file here) -->
http://s14.postimage.org/olbv9g3up/Test.jpg . The ones in yellow shades should be removed but it should not include the next color (ex: Blue and its data) but for some reason the macro below is also removing them
Code:
'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