#1
|
|||
|
|||
Create Word macro to delete text throughout the entire document
I need to create a macro that will turn on change tracking, delete all text that is formatted with red/underline, and then turns off change tracking. I have the macro working for one block of text at a time, but I'd like it to loop through the entire document.
I played a bit with Do Until loops, but this is my first time using Macros in Word and I suspect I am just not experienced enough to get it working... any help is appreciated. Code: Sub ClearRed() ' ' ClearRed Macro ' ' ActiveDocument.TrackRevisions = True Selection.Find.ClearFormatting With Selection.Find.Font .StrikeThrough = True .DoubleStrikeThrough = False .Color = wdColorRed End With With Selection.Find .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.Delete Unit:=wdCharacter, Count:=1 ActiveDocument.TrackRevisions = False End Sub |
#2
|
|||
|
|||
Code:
Sub ClearRed1() Dim oRng As Range ActiveDocument.TrackRevisions = True Selection.Find.ClearFormatting Set oRng = ActiveDocument.Range With oRng.Find With .Font .StrikeThrough = True .DoubleStrikeThrough = False .Color = wdColorRed End With While .Execute oRng.Delete Wend End With ActiveDocument.TrackRevisions = False lbl_Exit: Exit sub End Sub |
#3
|
|||
|
|||
That works perfectly - thank you!
Is there any chance you can explain how that works? I have another macro that I need to loop through as well... it will find blue text with an underline, remove the formatting, cut it, turn on change tracking, paste it back in, then turn off change tracking. I've tried to mimic what you had, but it doesn't seem to work... Code that works (without the loop): Sub ChangeTrackBlueFont() ' ' ChangeTrackBlueFont Macro ' ' Selection.Find.ClearFormatting With Selection.Find.Font .Underline = wdUnderlineSingle .Color = wdColorBlue End With With Selection.Find .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.Font.UnderlineColor = wdColorAutomatic Selection.Font.Underline = wdUnderlineNone Selection.Cut ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions Selection.PasteAndFormat (wdFormatOriginalFormatting) ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions End Sub |
#4
|
|||
|
|||
What you posted looks nothing like the solution I posted earlier.
Code:
Sub ChangeTrackBlueFont() Dim oRng As Range Selection.Find.ClearFormatting Set oRng = ActiveDocument.Range With oRng.Find With .Font .StrikeThrough = True .DoubleStrikeThrough = False .Color = wdColorBlue End With While .Execute oRng.Delete Wend End With ActiveDocument.TrackRevisions = False Set oRng = ActiveDocument.Range Selection.Find.ClearFormatting With oRng.Find With .Font .Underline = wdUnderlineSingle .Color = wdColorBlue End With While .Execute With oRng.Font .UnderlineColor = wdColorAutomatic .Underline = wdUnderlineNone End With oRng.Cut ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions oRng.PasteAndFormat (wdFormatOriginalFormatting) ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions Wend End With lbl_Exit: Exit Sub End Sub |
#5
|
|||
|
|||
I apologize if I was unclear - I had two macros that needed to loop. I asked the question on the first one, and was hoping that I'd be able to mimic the solution on my second one - but it didn't work.
So I posted the second one to try and get more information. So you are right - the second one does not look like the first, as I was hoping to understand how to create the loop and do it myself... but it looks like you saved me the effort. It works flawlessly - thank you! |
#6
|
|||
|
|||
I just noticed that these do not look at the content of footnotes - though they do seem to look at endnotes. Is there something additional that needs to be done to include looping through footnotes?
|
#7
|
|||
|
|||
That is because we didn't search in the footnote or endnote story ranges. It also wouldn't find the formatted text in textboxes, headers or footers, comments etc.
Note: Your macros are not processing "real" endnotes. To search in footnotes and "real" endnotes modify as follows: Code:
Sub ClearRed1() Dim oRng As Range ActiveDocument.TrackRevisions = True Selection.Find.ClearFormatting Set oRng = ActiveDocument.Range With oRng.Find With .Font .StrikeThrough = True .DoubleStrikeThrough = False .Color = wdColorRed End With While .Execute oRng.Delete Wend End With On Error Resume Next Set oRng = ActiveDocument.StoryRanges(wdFootnotesStory) With oRng.Find With .Font .StrikeThrough = True .DoubleStrikeThrough = False .Color = wdColorRed End With While .Execute oRng.Delete Wend End With Set oRng = ActiveDocument.StoryRanges(wdEndnotesStory) With oRng.Find With .Font .StrikeThrough = True .DoubleStrikeThrough = False .Color = wdColorRed End With While .Execute oRng.Delete Wend End With On Error GoTo 0 ActiveDocument.TrackRevisions = False lbl_Exit: Exit Sub End Sub |
#8
|
|||
|
|||
|
#9
|
|||
|
|||
Thank you again - and that article is actually really helpful to explain what's going on. Much appreciated!
|
Tags |
loop, macro |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro to search for a particular word, copy the entire paragraph to a new document | Productivity | Word VBA | 2 | 10-25-2019 06:40 AM |
Delete entire paragraph after key word | jeffreybrown | Word | 2 | 07-27-2018 02:29 PM |
Need Word Macro to Delete Text | rsrasc | Word VBA | 4 | 04-18-2018 11:32 PM |
Microsoft Word macro to find text, select all text between brackets, and delete | helal1990 | Word VBA | 4 | 02-05-2015 03:52 PM |
Macro to create new word doc and save the file using String found in the document | VBNation | Word VBA | 2 | 02-08-2013 07:14 AM |