Solved: Find red or strikethrough text

[Bernadette]

I need a macro that will find text that is red or strikethrough (done manually not with Track Changes) then select the paragraph - copy it to a new document and repeat until it reaches the end of the first document. Thanks so much if you can help!

[gotmatt]

Hey Bernadette!

I'm new to VBA, so this code many not be the most efficient or bulletproof, but this is how you learn I guess! :)

This won't cover the whole process, but it may get you started:
Sub FindStrikethrough()

Dim par As Paragraph

For Each par In ActiveDocument.Paragraphs
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Font.StrikeThrough = True
'Replace the line above with ".Font.Color = wdColorRed" in order
'to find red text.
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute
Selection.Copy
'Insert paste command to other document
'Insert paragraph in other document "Selection.TypeParagraph"
Next

End Sub
I haven't tried it yet, but something like this, used where "'Insert paste command..." is above, might work:
Documents("YourSecondDocument.doc").Activate
Selection.EndKey wdStory
Selection.PasteAndFormat wdPasteDefault
Best of luck!

[Bernadette]

It's starting to work! Thanks so much for your help. I got it to copy the strikethrough text to the second document however it copies the last entry about 7 times. Here is the code so far:

Sub FindStrikethrough()
'Grabs the name of the document to be able to refer to it later
winDoc = ActiveDocument.ActiveWindow.Index
strDocName = Windows(winDoc)
'Creates a second document and stores its name for later
Set FirstDocName = ActiveDocument
Documents.Add DocumentType:=wdNewBlankDocument
Set SecondDocName = ActiveDocument
'Returns to first document
Windows(strDocName).Activate

Dim par As Paragraph

For Each par In ActiveDocument.Paragraphs
Selection.Find.ClearFormatting
With Selection.Find
.text = ""
.Replacement.text = ""
.Font.Strikethrough = True
'Replace the line above with ".Font.Color = wdColorRed" in order
'to find red text.
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute
Selection.copy
'Insert paste command to other document
'Once it found it, it copies the sentence to the second document
Selection.copy
Windows(SecondDocName).Activate
'Makes sure that it is at the end of the second document
Selection.EndKey Unit:=wdStory
Selection.PasteAndFormat (wdPasteDefault)
SecondDocName.Range.InsertAfter vbCr & vbCr
Windows(strDocName).Activate

'Insert paragraph in other document "Selection.TypeParagraph"
Next

End Sub

[gotmatt]

Not sure why it'd be copying the last one 7 times. Stepping through the code with F8 might reveal the issue.

If it's a very large document, with lots of red text, I'd try something like this, which will prompt you once you've reached the last section (which seems to be copying several times...)

winDoc = ActiveDocument.ActiveWindow.Index
strDocName = Windows(winDoc)
Set FirstDocName = ActiveDocument
Documents.Add DocumentType:=wdNewBlankDocument
Set SecondDocName = ActiveDocument
Windows(strDocName).Activate
Dim par As Paragraph
Dim counter As Integer

counter = 1

For Each par In ActiveDocument.Paragraphs
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Font.StrikeThrough = True
'Replace the line above with ".Font.Color = wdColorRed" in order
'to find red text.
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
If counter = ActiveDocument.Paragraphs.Count Then
msgbox "Code has reached the last section." '(Break code here somehow)
End If
Selection.Find.Execute
Selection.Copy
Windows(SecondDocName).Activate
'Makes sure that it is at the end of the second document
Selection.EndKey Unit:=wdStory
Selection.PasteAndFormat (wdPasteDefault)
SecondDocName.Range.InsertAfter vbCr & vbCr
Windows(strDocName).Activate
counter = counter + 1
Next

End Sub

[gotmatt]

*Also, I think you have a redundant "Selection.Copy" method before pasting into the second document. Don't see why that would mess anything up, but might be worth looking into.

[Frosty]

Bernadette: use the VBA tags, it makes it much easier to read :)

The problem in the code is that you don't need to iterate through paragraphs if you're using the find object... that creates a loop (i.e., you have 7 paragraphs in a document, so you do your Selection.Find 7 times)... those two concepts aren't really related. Find finds stuff. Loops cycle through stuff.

Matt is right in that recording a macro is the best way to learn... especially when dealing with the find object

Sub SearchAndCopyDemo()
Dim oCopyIntoDoc As Document
Dim rngSearch As Range
Dim rngPaste As Range

'work on your search document
Set rngSearch = ActiveDocument.Range
'the document you'll paste into
Set oCopyIntoDoc = Documents.Add
'and the range
Set rngPaste = oCopyIntoDoc.Range

With rngSearch.Find
.Text = ""
.Replacement.Text = ""
.Font.StrikeThrough = True
.Font.ColorIndex = wdRed
'Replace the line above with ".Font.Color = wdColorRed" in order
'to find red text.
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False

Do While .Execute = True
'this is the found range
rngSearch.Copy
'insert a blank paragraph
rngPaste.InsertAfter vbCr
rngPaste.Collapse wdCollapseEnd
rngPaste.Paste
Loop
End With
'oCopyIntoDoc.Saved = True
'oCopyIntoDoc.Close
End Sub

[Frosty]

And matt: read up on the For...Loops :)

[Bernadette]

Thanks Matt & Frosty, it's getting there, however it repeats the last paragraph 5 times. Also I need it to find the text whether it's strikethrough or red - select the whole paragraph not just the text and it is doing that. How do I paste it in here showing the formatting that is in VBA? Many thanks! Here is my sample text:

[1] Paragraph 1 new text contains one group of ones. 111. It is a very short paragraph.
[2] Paragraph 2 contains new text 2 two groups of twos. 222. 2222. It is a bit longer than the previous paragraph.
[3] Paragraph 3 contains new text 3 three groups of threes. 33333. 3333. 333.
[4] Paragraph 4 has strikethrough text contains four groups of fours. 4444. 444. 444. 444444.
[5] Paragraph 5 contains five groups of fives. 5555. 555555555. 55. 555. 55555.
This new paragraph has been PASTED between the old paragraph 1 and paragraph 2.
here is the code I have so far:

Sub FindStrikethrough()
winDoc = ActiveDocument.ActiveWindow.Index
strDocName = Windows(winDoc)
Set FirstDocName = ActiveDocument
'Documents.Add DocumentType:=wdNewBlankDocument
Set SecondDocName = ActiveDocument
Windows(strDocName).Activate
Dim par As Paragraph
Dim counter As Integer

counter = 1
'
'Grabs the name of the document to be able to refer to it later
winDoc = ActiveDocument.ActiveWindow.Index
strDocName = Windows(winDoc)
'Creates a second document and stores its name for later
Set FirstDocName = ActiveDocument
Documents.Add DocumentType:=wdNewBlankDocument
Set SecondDocName = ActiveDocument
'Returns to first document
Windows(strDocName).Activate
'Dim par As Paragraph
For Each par In ActiveDocument.Paragraphs
Selection.Find.ClearFormatting
With Selection.Find
.text = ""
.Replacement.text = ""
.Font.Strikethrough = True
'Replace the line above with ".Font.Color = wdColorRed" in order
'to find red text.
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False

End With
If counter = ActiveDocument.Paragraphs.Count Then
MsgBox "Code has reached the last section." '(Break code here somehow)
End If
Selection.Find.Execute

'Insert paste command to other document
'Once it found it, it copies the sentence to the second document
Selection.MoveUp Unit:=wdParagraph, Count:=1
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.copy
Selection.copy
Selection.MoveDown Unit:=wdParagraph, Count:=1

Windows(SecondDocName).Activate
'Makes sure that it is at the end of the second document
Selection.EndKey Unit:=wdStory
Selection.PasteAndFormat (wdPasteDefault)
SecondDocName.Range.InsertAfter vbCr & vbCr
Windows(strDocName).Activate
'Insert paragraph in other document "Selection.TypeParagraph"
counter = counter + 1
Next


End Sub

[Frosty]

There is a button which will do that VBA tagging for you-- but you put brackets around VBA and /VBA ("[" & "]").

Don't use the code you have so far... start with the code I posted (that's why I posted it :)). The code you are using has a flawed methodology.

Another question:

You need to find text which is Red OR strikethrough? Or you need to find text which is Red AND strikethrough?

I understand you need to paste the entirety of the paragraph in which you find the formatted text... but you will get erroneous results with that methodology, depending on how the source document is set up (i.e., you may think of something as a single paragraph when word views it as multiple paragraphs), so the following is a "use at your own risk" kind of thing.

Sub SearchAndCopyDemo()
Dim oCopyIntoDoc As Document
Dim oSearchDoc As Document
Dim rngSearch As Range
Dim rngPaste As Range

'work on your search document
Set oSearchDoc = ActiveDocument
Set rngSearch = oSearchDoc.Range

'the document you'll paste into
Set oCopyIntoDoc = Documents.Add
Set rngPaste = oCopyIntoDoc.Range
rngPaste.Collapse wdCollapseStart

'first, set up all of our find criteria except the stuff that switches...
With rngSearch.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With

'now our other ones-- first Red
rngPaste.Text = "Paragraphs with Red in them" & vbCr
rngPaste.Paragraphs(1).Alignment = wdAlignParagraphCenter
rngPaste.Font.Bold = True
With rngSearch.Find
.ClearFormatting
.Font.ColorIndex = wdRed
Do While .Execute = True
'this is the found range, which we'll modify to capture all paragraphs which were found
rngSearch.Start = rngSearch.Paragraphs.First.Range.Start
rngSearch.End = rngSearch.Paragraphs.Last.Range.End
rngSearch.Copy
rngSearch.Collapse wdCollapseEnd
'insert a blank paragraph
rngPaste.Collapse wdCollapseEnd
rngPaste.Paste
Loop
End With

'now our other ones-- now strikethrough... resetting our range to do so
Set rngSearch = oSearchDoc.Content
rngPaste.Collapse wdCollapseEnd
rngPaste.Text = "Paragraphs with Strikethrough in them" & vbCr
rngPaste.Paragraphs(1).Alignment = wdAlignParagraphCenter
rngPaste.Font.Bold = True
With rngSearch.Find
.ClearFormatting
.Font.StrikeThrough = True
Do While .Execute = True
'this is the found range, which we'll modify to capture all paragraphs which were found
rngSearch.Start = rngSearch.Paragraphs.First.Range.Start
rngSearch.End = rngSearch.Paragraphs.Last.Range.End
rngSearch.Copy
rngSearch.Collapse wdCollapseEnd
'insert a blank paragraph
rngPaste.Collapse wdCollapseEnd
rngPaste.Paste
Loop
End With
'oCopyIntoDoc.Saved = True
'oCopyIntoDoc.Close
End Sub

[Frosty]

Bernadette:

Couple of quick concepts will help you.

1. F8 (step into). If you can, try to be able to see both your Word window and the VBA window... then put your cursor in the VBA code you want to use, and press F8. That let's you "step through" each line of code, and also watch what's happening in your document

2. Immediate window. This is useful for testing whether your range object is what you want it to be during the step-through process. So, while you are in the middle of your code... you can try typing "rngSearch.Select" or "rngPaste.Select" (without the quotes) to see what's about to happen (what you're going to copy, what you're going to paste.

3. Make sure you always have Option Explicit at the top of any code modules. This will help you avoid confusing mistakes down the road.

4. In general, the best approach to learning how to do something is recording a macro. While the recorded macro will always use the Selection object heavily, it is generally going to be fairly readable... and you'll be able to extract out chunks you need. Don't always worry about the "looping" part of code (since those are always the good questions to ask on a forum like this) so much as getting the simplest version of having your entire function run once successfully.

For example, if you had recorded a macro that found Red Text, then you copied that entire paragraph (using keyboard shortcuts rather than the mouse--macro recording doesn't record mouse stuff), into a new document... you would have been very close.

And don't forget to put your cursor on some bit of code you don't understand, and hit F1. Word's help will explain some of those objects that seem incomprehensible, and you'll be well on your way to being a programmer! Good luck. Let us know if there's something else about the above macro you need help with.

- Frosty

[Frosty]

Oh, and the reason you get multiple paragraphs at the end is because that's what that macro is telling it to do. You're saying...
1. For every paragraph in this document do the following steps (so a 7 paragraph document will do the following steps #2-#4 7 times, a 5 paragraph document will do it 5 times, etc):
2. Search for some stuff.
3. Copy what you find.
4. Paste that into a new document.

Nowhere did you limit your search to the paragraph defined in the loop (i.e., "for each paragraph in the document, search that paragraph for some stuff")... you simply said "for each paragraph in the document, search the whole document" which obviously doesn't make a lot of sense, and is why you're getting confusing results.

Nor would you really ever want to use a structure which does that. The Find object is much much faster at finding stuff than going through each paragraph and then triggering a find within that paragraph. There are times you might want to limit where you're looking-- but never in a "For each paragraph in my document look for stuff" kind of way.

So your document might have 20 paragraphs, but only 5 items you want to copy... so you're going to get the 5 items you want, and then keep pasting another 15 times... because that's how many times you told your macro to "do something"

[Bernadette]

Frosty, this is fantastic! I can't thank you enough. It works beautifully, the only thing left is that I need it to find and select the paragraph whether it has red text and/or strikethrough, not separately.

Matt & Frosty: I am trying out the F8 and this is a very useful tip.

[Frosty]

Well, I may need to eat my words about never doing a For Each oPara In ActiveDocument.Paragraphs loop for this kind of function.

There are two ways to approach what you want to do (well, there are many ways-- but two basic concepts). There's the quick/easy/slow way... and there's the not-so-quick/not-so-easy/fast way.

The two approaches (generally) are:
1. Loop through each paragraph, searching that paragraph's range for red and/or strikethrough text, and build your document from that (this can be very slow, especially if you happen to have a document which has a lot of big tables in it)

2. Perform the search on the entire document twice, building up your ordered list of red or red and strikethrough paragraphs (by doing a search on red text, which will also find red/strikethrough text), and then build up a list of strikethrough-only paragraphs (by doing a search on strikethrough and not-red text)... and then put that list (ordered) into a new document. This code will be a little less readable by a novice (because you'd use collections), but it properly leverages the speed of the Find object in Word over a loop which would iterate through each paragraph in a document.

So... how complicated are these documents? How many tables do they have? How many documents will you be doing this on in a single day, etc?

[Bernadette]

Hi Frosty, thanks again for your help! The documents are simple numbered paragraphs with some titles that are not numbered. There are no tables and they range up to about 50 pages. The number of documents is about one a week.

[Frosty]

We'll go the easy way then. And if there comes a time where the macro seems slow, it would probably be a good idea to generate a new thread, post the code you're using, and reference a link to this thread.

At the least, you see a lesson in modularizing code, and using a function. One routine does the "looping" through the paragraphs, another routine (a function) takes care of doing the evaluation of the paragraph. In this way, you can change the criteria as many times as you want, without having to re-think your looping.

Hope this helps!

'----------------------------------------------------------------------------------------------
'Our top function to run
'----------------------------------------------------------------------------------------------
Public Sub SearchAndCopyDemo()
Dim oCopyIntoDoc As Document
Dim oSearchDoc As Document
Dim rngPaste As Range
Dim oPara As Paragraph

'work on your search document
Set oSearchDoc = ActiveDocument

'create the document and set range you'll paste into
Set oCopyIntoDoc = Documents.Add
Set rngPaste = oCopyIntoDoc.Range

'now loop through each paragraph in your document...
For Each oPara In oSearchDoc.Paragraphs
'and check to see if this paragraph has the formatting you want to copy, and if it does...
If fCopyThisParagraph(oPara) Then
'copy the paragraph
oPara.Range.Copy
'and move the paste range to the end of wherever it was before
rngPaste.Collapse wdCollapseEnd
'and paste it in
rngPaste.Paste
End If
Next
End Sub
'----------------------------------------------------------------------------------------------
'Our function to check the passed in paragraph and see if it matches any of the required criteria
'----------------------------------------------------------------------------------------------
Public Function fCopyThisParagraph(oPara As Paragraph) As Boolean
Dim rngSearch As Range
Dim bFoundFormatting As Boolean

'set up our rnage
Set rngSearch = oPara.Range
'first, set up all of our find criteria except the stuff that switches...
With rngSearch.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False

'check for red text
.Font.ColorIndex = wdRed
'see if we find it
If .Execute = True Then
bFoundFormatting = True
End If

'if we didn't find it, execute another search
If bFoundFormatting = False Then
'reset the formatting (so we aren't looking for red & strikethrough)
.ClearFormatting
.Font.StrikeThrough = True
'and check
If .Execute = True Then
bFoundFormatting = True
End If
End If
End With

'return whether we found it or not
fCopyThisParagraph = bFoundFormatting
End Function

[Bernadette]

Frosty, this is so amazing! I am really impressed and I thank you very very much! It works!!!!!!!

[Bernadette]

This macro was awesome. What I am doing is manually tracking changes in documents using red text and strikethrough. It's a long story why I'm not using Automatic Track Changes. However some users have gotten confused and are using the manual track changes and the automatic track changes in the same document. I was wondering if I could also get the macro to not only find red text and copy it to a new document but also any new text that was inserted with automatic track changes. Any help would be much appreciated. Thank you!