Solved

Extract and print only paragraphs having highlighted words

Posted on 2014-01-21
7
374 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
A Knowledge Base That Stays Up-to-Date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

This article will show you how to use shortcut menus in the Access run-time environment.
My experience with Windows 10 over a one year period and suggestions for smooth operation
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …
This Micro Tutorial well show you how to find and replace special characters in Microsoft Word. This is similar to carriage returns to convert columns of values from Microsoft Excel into comma separated lists.

708 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

18 Experts available now in Live!

Get 1:1 Help Now