#1
|
|||
|
|||
Find several words in document, copy paragraph and create new document
Hello MS Office community.
I am trying create a vba script that will search for multiple words, copy the paragraph which has that word and will insert into a new document. I found the following scripts which works amazingly but with one text only. How can I modify this script, so instead of only one search to have multiples, array of words to search for. Any help will be greatly appreciated. The script below will search for "1945" and will copy the paragraph that contains "1945" and insert into new document. How to make do the same but for several texts example 1945, 1946, 1947 etc Thank you in advance ================================ Sub CopyParas Selection.Find.ClearFormatting With Selection.Find .Text = "1945" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Do While Selection.Find.Execute Selection.StartOf Unit:=wdParagraph Selection.MoveEnd Unit:=wdParagraph sBigString = sBigString + Selection.Text Selection.MoveStart Unit:=wdParagraph Loop Documents.Add DocumentType:=wdNewBlankDocument Selection.InsertAfter (sBigString) End Sub ------------------------------------------------------------ |
#2
|
|||
|
|||
Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 01/31/2019 Dim oRng As Range Dim arrFind() As String Dim lngIndex As Long Dim strContent Dim oThisDoc As Document Dim oDoc As Document Set oThisDoc = ActiveDocument arrFind = Split("1945,1946,1947", ",") For lngIndex = 0 To UBound(arrFind) oThisDoc.Activate strContent = vbNullString Set oRng = ActiveDocument.Range With oRng.Find .ClearFormatting .Text = arrFind(lngIndex) .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False Do While .Execute strContent = strContent & oRng.Paragraphs(1).Range.Text & vbCr Loop If strContent <> vbNullString Then Set oDoc = Documents.Add(, , wdNewBlankDocument) oDoc.Range.Text = strContent End If End With Next lngIndex lbl_Exit: Exit Sub End Sub |
#3
|
||||
|
||||
Quote:
.Text = "<194[5-7]>" with: .MatchWildcards = True and delete: .MatchCase = False .MatchWholeWord = False .MatchSoundsLike = False .MatchAllWordForms = False This will ensure your output is in the same order as in the original document.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
|||
|
|||
Thank you, thank you, thank you!!!
God Bless you. Quick question, what modification will require that instead of opening a new word for each "year" text searched, to put them in one word document? So starting 1945 and then 1946 and then 1947 etc.. Please and thank you! |
#5
|
|||
|
|||
Thank you thank you Greg Maxey!
Quote:
|
#6
|
|||
|
|||
Greg Maxey script is exactly what I need with the only exception that if its possible to put the output in one document instead one document for each value of the array. Dear sir do you have a donation section in you website? I would like to buy you a cup of coffee as way to thank you for helping me and serving in the US Navy. God Bless you!
|
#7
|
|||
|
|||
It is just a matter of rearranging and a few minor changes.
Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 01/31/2019 Dim oRng As Range Dim arrFind() As String Dim lngIndex As Long Dim strContent Dim oThisDoc As Document Dim oDoc As Document Set oThisDoc = ActiveDocument arrFind = Split("1945,1946,1947", ",") Set oRng = ActiveDocument.Range strContent = vbNullString For lngIndex = 0 To UBound(arrFind) Set oRng = ActiveDocument.Range With oRng.Find .ClearFormatting .Text = arrFind(lngIndex) .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False Do While .Execute strContent = strContent & oRng.Paragraphs(1).Range.Text & vbCr Loop End With Next lngIndex If strContent <> vbNullString Then Set oDoc = Documents.Add(, , wdNewBlankDocument) oDoc.Range.Text = strContent oDoc.Activate End If lbl_Exit: Exit Sub End Sub I do. You can use any of the PayPal donate links on the various webpages. Thank you. |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Find and highlight multiple words in MS Word document | AtaLoss | Word VBA | 37 | 09-22-2021 12:04 PM |
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 |
Copy text to new document based on paragraph numbering | mike.mm | Word VBA | 7 | 11-22-2016 06:14 AM |
How to select and copy to clipboard an entire document except for a paragraph and keep formatting | TD_123 | Word VBA | 7 | 06-16-2015 03:30 PM |
Find and highlight multiple words in a document | flatop | Word VBA | 3 | 04-16-2014 10:29 PM |