Solved

Extract and print only paragraphs having highlighted words

Posted on 2014-01-21
7
380 Views
Last Modified: 2014-01-22
I need suggestions for Word 2013 macros to help me, as follows:

The Input:
I'm using Word in Office 2014 under Win 8.1 to do research involving a very long document (hundreds of pages) where I need to focus my searches on pages and/or paragraphs that  contain at least one (of up to 20) highlighted words.

The Output:
(a)  The goal is produce a 2nd document for printing only the paragraphs where one or more of the highlighted (target) words occur.  

(b) Targeted paragraphs copied to the 2nd doc. should be inserted in their original sequence, without forced page breaks, but with a couple of blank lines in between (with all targeted words remaining highlighted).  For each paragraph copied into the 2nd doc, I really need to know what page it came from in the original doc.  Perhaps the easiest way to capture this page info. might be to grab it from the location of the first word in each paragraph before the paragraph is copied to the 2nd doc.  That page number should be printed in the line before the paragraphs.

(c) Printing must not be automatic, but under my manual control, after the macro has completed and I am able to inspect the results.

Thanks,

WS
0
Comment
Question by:WaterStreet
  • 3
  • 3
7 Comments
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39798150
Does this help?
Sub CopyParagraphs()
    Dim DocA As Document
    Dim DocB As Document
    Dim strWords() As String
    Dim para As Paragraph
    Dim i As Integer
    Dim bFound As Boolean
    
    strWords = Split("word1,words", ",") 'list of words to find
    Set DocA = ActiveDocument
    Set DocB = Documents.Add
    
    For Each para In DocA.Paragraphs
         bFound = False
        For i = 0 To UBound(strWords)
            With para.Range.Find
                .Highlight = True
                .Text = strWords(i)
                If .Execute() Then
                    bFound = True
                    Exit For
                End If
            End With
        Next i
        If bFound Then
            para.Range.Copy
            DocB.Bookmarks("\EndOfDoc").Range.Text = "Page " & para.Range.Characters.First.Information(wdActiveEndPageNumber) & vbCr
            DocB.Bookmarks("\EndOfDoc").Range.Paste
            DocB.Bookmarks("\EndOfDoc").Range.Text = vbCr & vbCr
        End If
    Next para
End Sub

Open in new window

0
 
LVL 18

Author Comment

by:WaterStreet
ID: 39798256
Didn't work.

It created the 2nd doc. The hourglass was on for about 10 sec. while the insertion mark flashed very rapidly.

BTW,  the document with the highlights is several hundred pages, has up to about 25 different words that might be highlighted, and a targeted paragraph could contain as few as one or as many as all of the 25 different highlighted words.  

Though that maximum number is theoretical, all it takes is one highlighted word to flag the paragraph for copying into the new doc.  I think saw that your code recognized that. :-))

Thanks in advance.
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39798668
How many words did you put in the list?

Note that when we get it working, it might be possible to tweak the code for better performance, depending on the numbers of hits, list words and paragraphs in the document.
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 18

Author Comment

by:WaterStreet
ID: 39798768
There are 27 different words that were each highlighted throughout the doc.

I saw one paragraph that has 23 of its words highlighted, but a lot of them are repeats of  the different words that would be highlighted.
0
 
LVL 14

Expert Comment

by:DrTribos
ID: 39799227
Hi WaterStreet,

Not for points, taking a back seat and watching on in interest.  Say you are searching for the word FindMe and that word appears 5 times in a paragraph, once it has been found is it ok to stop looking for FindMe in the rest of the paragraph?

Graham - I forgot about the end of doc bookmark, thanks for the reminder :-)
0
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 500 total points
ID: 39799366
Hi Steve,
That's good to know. Using the end bookmark looks a bit clumsy, but it's the simplest way that I know to address the end of a document. The start is simpler: doc.Range(0,0).

Waterstreet,
I didn't put that very well, I meant to ask how many words you edited into in the list in the code ("word1" and "word2" in my test).

However, I may have misunderstood the question. I thought that you wanted specific words that were also highlighted. I now see that you could have meant any word that contains a highlight. That is simpler:
Sub CopyParagraphs()
    Dim DocA As Document
    Dim DocB As Document
    Dim para As Paragraph
    
    Set DocA = ActiveDocument
    Set DocB = Documents.Add
    
    For Each para In DocA.Paragraphs
        With para.Range.Find
            .Highlight = True
            If .Execute() Then
                para.Range.Copy
                DocB.Bookmarks("\EndOfDoc").Range.Text = "Page " & para.Range.Characters.First.Information(wdActiveEndPageNumber) & vbCr
                DocB.Bookmarks("\EndOfDoc").Range.Paste
                DocB.Bookmarks("\EndOfDoc").Range.Text = vbCr & vbCr
            End If
        End With
    Next para
End Sub

Open in new window

0
 
LVL 18

Author Closing Comment

by:WaterStreet
ID: 39801111
Works wonderfully.  Thanks.

I decided to eliminate the extra CR's that I requested so as to reduce the number of pages in the resulting doc, as follows:

========================
Sub CopyHighlightedParagraphs()
    Dim DocA As Document
    Dim DocB As Document
    Dim para As Paragraph
   
    Set DocA = ActiveDocument
    Set DocB = Documents.Add
   
    For Each para In DocA.Paragraphs
        With para.Range.Find
            .Highlight = True
            If .Execute() Then
                para.Range.Copy
                DocB.Bookmarks("\EndOfDoc").Range.Text = "Page " & para.Range.Characters.First.Information(wdActiveEndPageNumber) & " - "
                DocB.Bookmarks("\EndOfDoc").Range.Paste
            End If
        End With
    Next para
End Sub
======================

I'm closing this question, but hope to quickly open another asking to do the opposite  -- extract only those paragraphs that have no highlighted words within.  Hopefully, their is a time-efficient way to do this.

WS
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Word is a program we have all encountered at some point, but very few of us have dug deep into its full scope of features, let alone customized it to suit our needs. Luckily making the ribbon (aka toolbar, first introduced in Word 2007) wo…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

920 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now