Hi Ron!

I read your question 2 or 3 days ago, and I thought "wow, that sounds simple, I'll go back and answer that when I have time, but I bet someone else will surely answer any minute now before I get a chance."

well...

maybe it wasn't so simple, and maybe that's why no one has jumped on it yet. I began fooling around with this this morning, and between going out to lunch and running a few errands, this problem has taken me just about all day!! I can't believe it.

It sounds like you actually want to learn about Word macros, Ron, rather than just copy and paste them. So I would suggest that if you wish to understand the macro I have written, please read the entire thread regarding Johnske's question, Cleaning up a Word document.

The key here is the use of "wildcards." Before I wrote this macro for you, I studied the site that mdmackillop suggested in the thread about Johnske's question. (the suggested site is: Finding and Replacing Characters Using Wildcards, on the Word MVPs site)

So...

what this macro does is loop through all sentences in a document. It will identify a "sentence" as anything that begins either at the beginning of a paragraph or at the end of a prior sentence (meaning that it follows a . or a ? or a !) and that subsequently ends at the very next . or ? or ! without any intervening hard returns.

As the macro identifies each sentence, it then does a "mini search" within the sentence to find your desired word. If the desired word is found, then the sentence is saved in memory.

Once all sentences have been searched, then we can tell the macro (in the future) to do whatever we want with the "good" sentences.

Right NOW, in this current macro, a new document is created and a TABLE is inserted with each sentence in a single cell of the TABLE. So, you may then manually copy the table and paste it into an Excel spreadsheet. That part can also later be automated within the macro.

Also, I found out that my macro fails (in a very aggravating way!!!) if the document contains fields or hyperlinks. It may also fail if the document has other "strange stuff" in it, but I have definitely confirmed that it does not like fields or hyperlinks.

BUT!! DON'T WORRY IF YOUR DOCUMENT HAS THAT STUFF. I incorporated a "workaround" into my macro. Before searching, the macro actually copies the entire document and does a "text only" paste operation into a HIDDEN document (that can't be seen on screen but that is running in the backgroun). So the macro will safely be fed ONLY TEXT from the hidden doc.

Here it is:

[vba]Sub CopyCertainSentences()

Dim myOriginalDoc As Document
Dim myHiddenDoc As Document
Dim OldValue As Long
Dim ArrayOfSentences() As String
Dim TargetWord As String

TargetWord = Trim(InputBox("Enter the word that will be used to select sentences:"))
If TargetWord = "" Then MsgBox "No word entered." & vbCr & vbCr & "EXITING MACRO": End

ReDim ArrayOfSentences(0)
Set myOriginalDoc = ActiveDocument
Set myHiddenDoc = Documents.Add(, , wdNewBlankDocument, False)

On Error GoTo Ending 'if an error interferes, I want to at least close HiddenDoc

'*********************************
'*******Transfer the text*********
myOriginalDoc.Select
Selection.Copy

myHiddenDoc.Select
Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False
'*********************************
'*********************************

myHiddenDoc.Bookmarks("\StartOfDoc").Select

'****Set search parameters***************
Selection.Find.ClearFormatting
With Selection.Find
.Text = "": .Replacement.Text = "": .Forward = True: .Wrap = wdFindStop
.Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchWildcards = True
.MatchSoundsLike = False: .MatchAllWordForms = False
End With
'****************************************

Do

Selection.Find.Text = "[^13.\?\!]{1}[!.\?\!^13]@[.\!\?]{1}"
Selection.Find.Execute

OldValue = Selection.Start

Selection.Find.Text = "<*>*[.\!\?]{1}"
Selection.Find.Execute

If InStr(1, Selection.Text, TargetWord, vbTextCompare) > 0 Then
ArrayOfSentences(UBound(ArrayOfSentences)) = Selection.Text
ReDim Preserve ArrayOfSentences(UBound(ArrayOfSentences) + 1)
End If

Selection.Collapse wdCollapseEnd
Selection.MoveLeft wdCharacter, 1, False

Loop While Selection.Start > OldValue

Ending:
myHiddenDoc.Close False
DoEvents
If Err.Number > 0 Then On Error GoTo 0: Resume 'go back to any error after closing HiddenDoc

ExcelBusiness ArrayOfSentences

End Sub


Function ExcelBusiness(ArrayOfSentences() As String)

Dim sen As Long 'a counter to loop through the sentences
Dim myNewDoc As Document

Set myNewDoc = Documents.Add

For sen = 0 To (UBound(ArrayOfSentences) - 1)

myNewDoc.Bookmarks("\EndOfDoc").Select
Selection.TypeText ArrayOfSentences(sen) & vbCr

Next

myNewDoc.Select
Selection.ConvertToTable wdSeparateByParagraphs, , 1, , wdTableFormatNone

End Function
[/vba]


I'm also attaching the test document that I have been using. So far so good with my test document. the macro seems to be doing exactly what I want it to.