Remove Red macro

netchie · #1 03-14-2013, 04:07 PM

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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to remove blank column	netchie	Word VBA	4	03-14-2013 02:22 PM
Need VBA For Macro On How To Remove Specific Words	netchie	Word VBA	6	08-28-2012 03:37 PM
Macro to remove MacroButtons	ilkks	Word VBA	3	05-22-2011 11:03 PM
Need help on Macro 03- Find text - if text is blank then remove line	simpleonline1234	Word VBA	1	02-25-2011 02:28 AM
Macro to remove duplicates in Refrences list	HowardC	Word VBA	0	05-20-2010 09:57 AM