Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-31-2019, 01:04 AM
coolio2341 coolio2341 is offline Find several words in document, copy paragraph and create new document Windows 7 64bit Find several words in document, copy paragraph and create new document Office 2013
Novice
Find several words in document, copy paragraph and create new document
 
Join Date: Jan 2019
Posts: 4
coolio2341 is on a distinguished road
Default 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






------------------------------------------------------------
Reply With Quote
  #2  
Old 01-31-2019, 05:37 AM
gmaxey gmaxey is offline Find several words in document, copy paragraph and create new document Windows 10 Find several words in document, copy paragraph and create new document Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,421
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

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
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #3  
Old 01-31-2019, 06:06 AM
macropod's Avatar
macropod macropod is offline Find several words in document, copy paragraph and create new document Windows 7 64bit Find several words in document, copy paragraph and create new document Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Quote:
Originally Posted by coolio2341 View Post
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
With your original code, if it's a series of such years, use:
.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]
Reply With Quote
  #4  
Old 01-31-2019, 06:10 AM
coolio2341 coolio2341 is offline Find several words in document, copy paragraph and create new document Windows 7 64bit Find several words in document, copy paragraph and create new document Office 2013
Novice
Find several words in document, copy paragraph and create new document
 
Join Date: Jan 2019
Posts: 4
coolio2341 is on a distinguished road
Default

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!
Reply With Quote
  #5  
Old 01-31-2019, 06:11 AM
coolio2341 coolio2341 is offline Find several words in document, copy paragraph and create new document Windows 7 64bit Find several words in document, copy paragraph and create new document Office 2013
Novice
Find several words in document, copy paragraph and create new document
 
Join Date: Jan 2019
Posts: 4
coolio2341 is on a distinguished road
Default

Thank you thank you Greg Maxey!







Quote:
Originally Posted by gmaxey View Post
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
Reply With Quote
  #6  
Old 01-31-2019, 06:21 AM
coolio2341 coolio2341 is offline Find several words in document, copy paragraph and create new document Windows 7 64bit Find several words in document, copy paragraph and create new document Office 2013
Novice
Find several words in document, copy paragraph and create new document
 
Join Date: Jan 2019
Posts: 4
coolio2341 is on a distinguished road
Default

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!
Reply With Quote
  #7  
Old 01-31-2019, 01:17 PM
gmaxey gmaxey is offline Find several words in document, copy paragraph and create new document Windows 10 Find several words in document, copy paragraph and create new document Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,421
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

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.
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Find several words in document, copy paragraph and create new document Find and highlight multiple words in MS Word document AtaLoss Word VBA 37 09-22-2021 12:04 PM
Find several words in document, copy paragraph and create new document 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
Find several words in document, copy paragraph and create new document 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

Other Forums: Access Forums

All times are GMT -7. The time now is 02:51 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft