Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Extract and print only paragraphs having highlighted words

Posted on 2014-01-21
7
397 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
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
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 15

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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
Office 365 is currently available in five editions. Three of them are for business use: Office 365 Business Essentials, Office 365 Business, and Office 365 Business Premium. Two of them are for home/personal use: Office 365 Home and Office 365 Perso…

809 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