Macro to find string and copy sentence containing string.

[TonyJollans]

Ah, the really difficult questions

If it relates to the same code it's probably as well to post here. If it's a standalone question, a new thread. Sometimes a new thread may get the attention of more people, but there are no rules about it - just do as you think best.

[ron]

Hello again,

I tried to work out the remainder of the requirement for my macro but have not had any luck. I tried several things but none worked out.

The macro should in addition to finding the specified word and copying the sentence that contains the word to an Excel workbook, I would also like the paragraph heading and number copied to the same Excel workbook in the same row, the number in one column the heading in another.
The closest I came was to use find, searching up for bold text, all the paragraph headings and numbers are bold, although I did not know how to start the search from the previously selected sentence so the search just stated from the bottom of the page.
The code I am using is what Tony posted on 11-22-04.

I am including a sample of text from a Word document for which the macro will be used. I?m not sure if the formatting will copy into this post but the paragraph numbers and headings are bullets.

Thanks
Ron


Sample:

1.1 Order of Precedence

In the event of a conflict between the SOW, specifications, or other documents, the order of precedence for the contractual documents is listed in the following descending order:

a. Purchase Order

b. This SOW

c. Other specifications and standards referenced in this SOW

The contractor shall notify the customer of any conflicting requirements in the contract SOW and system specifications.

2. REQUIREMENTS

2.1 Modification

The contractor shall perform modifications listed in this SOW. The modification requirements are contained in the Statement of Work Systems Modifications. Refer to Appendix C.

2.2 Technical Publications

The contractor shall provide documentation. Two sets shall be provided in accordance with the Integrated Schedule.

[TonyJollans]

Hi Ron,

You need to be precise in what you're searching for and, depending on your document there might be a better way with styles, but maintaining two different Find objects will allow you to search back from your sentence to find some bold text without disrupting the first Find, something like this ..
[VBA]
:
:

Dim aRange As Range
Dim bRange As Range

:

Set aRange = ActiveDocument.Range
Set bRange = ActiveDocument.Range

:
:

aRange.Copy

bRange.End = aRange.End
bRange.Collapse wdCollapseEnd

bRange.Find.ClearFormatting
bRange.Find.Font.Bold = True
With bRange.Find
.Text = ""
.Forward = False
.Wrap = wdFindStop
.Format = True
End With
bRange.Find.Execute

aRange.Collapse wdCollapseEnd

:
:[/VBA]

[geekgirlau]

Quick query regarding searching for little words ("to" etc.) - did you try setting the .MatchWholeWord property of the search to TRUE?

[ron]

Hi Tony,

Thanks for the latest suggestion, I will give it a try and let you know how it goes.

Ron

[ron]

Hello,

I?m back on this project.
It works as required thanks to Tony and others. Although I do have a problem if I copy the data to a sheet other than sheet 1. If I change the code to copy to another sheet only a portion of the data is copied. It is the same result if I name the sheets and use the sheet name in the code. Ultimately I will be searching for several words and coping to a different sheet for each word so I would like the ability to select which sheet to copy the data to.
Your continued help is greatly much appreciated.

My current code is below. If it is possible in this forum I can attach a sample document if required.

Regards,
Ron

[VBA]Sub FindWordCopySentence()

Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
Dim bRange As Range
Dim intRowCount As Integer
Dim strFileNameAndPath As String
Dim lngDisplayVal As Long
Dim PathAndFileName As String
On Error Resume Next

'open dialog box for user to select file
'and put path and file name in varable
With Application.Dialogs(wdDialogFileOpen)
lngDisplayVal = .Display
strFileNameAndPath = WordBasic.FileNameInfo$(.Name, 1)
End With
If lngDisplayVal <> -1 Then
MsgBox prompt:="Procedure canceled. Must select a file."
Exit Sub
End If

intRowCount = 3

Set aRange = ActiveDocument.Range
Set bRange = ActiveDocument.Range

With aRange.Find
Do
.Text = "shall" ' search word
.Execute
If .Found Then
aRange.Expand unit:=wdSentence
aRange.Copy

If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objSheet = appExcel.Workbooks.Open(strFileNameAndPath).Sheets("Sheet2")
End If

objSheet.Cells(intRowCount, 3).Select
objSheet.Paste
bRange.End = aRange.End
bRange.Collapse wdCollapseEnd

bRange.Find.ClearFormatting
bRange.Find.Font.Bold = True
With bRange.Find
.Text = ""
.Forward = False
.Wrap = wdFindStop
.Format = True
End With
bRange.Find.Execute

bRange.Copy

objSheet.Cells(intRowCount, 1).Select
objSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
False
intRowCount = intRowCount + 1

aRange.Collapse wdCollapseEnd
End If
Loop While .Found
End With
If Not objSheet Is Nothing Then
appExcel.Workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
End Sub[/VBA]

[TonyJollans]

Just had a quick look and there is no obvious reason why simply changing a Sheet name in a single line should have the effect you say. It'll be a day or so before I can look at this properly but I will come back. Meanwhile if you can post a sample document it would help (in the advanced input screen scroll down and under "Additional Options" there is a button labeled "Manage Attachments")

[ron]

Hi Tony,

Sorrry for the delay.
Attached is a sample document with the macro.
Thanks.

Ron

[SelimT]

Hi Ron and Others,

I was tasked with creating a Requirements Collection Sheet a couple of days ago for a work project (finding every sentence with "shall" in 30+ reports - thats a total of 10,000 items! Not having any VBA experience this task was daunting!

Using your macro cut my work load from a couple of months of manually cutting and pasting, to a few days.

I just wanted to say thanks for your effort.

I hope you get this, (even if it is an old thread!)

[TonyJollans]

Thank you, SelimT, and thank you for posting, as well as searching and finding, which action alone puts you in about the top 2% - most people ask first and think later, if at all.

[Aerogal]

I know this is an old thread, and I appreciate the guidance since my VBA is very rusty! The .Find function appears to be the function of choice when searching for text in a word document and copying the identified sentence to an excel worksheet. However, I'd like to search for sentences containing one of several text values, or an array of strings. Can anyone provide guidance on this? Do I have to read each sentence line by line and search for one of the (in my case 2) words? Thanks in advance.

[gmayor]

It would have been better had you started a new thread, however you can however find a sentence containing a word or words using Range.Find e.g.

Sub Macro1()
Const strFind As String = "lorem|ipsum" 'The words to find, each separated by '|'
Dim vFind As Variant
Dim orng As Range, oText As Range
Dim i As Long
    vFind = Split(strFind, "|")
    For i = LBound(vFind) To UBound(vFind)
        Set orng = ActiveDocument.Range
        With orng.Find
            Do While .Execute(FindText:=vFind(i))
                Set oText = orng.Sentences(1)
                oText.Select
                MsgBox vFind(i) & vbCr & oText.Text
                orng.Collapse 0
            Loop
        End With
    Next i
lbl_Exit:
    Exit Sub
End Sub

[Aerogal]

Hi Ron,

You need to be precise in what you're searching for and, depending on your document there might be a better way with styles, but maintaining two different Find objects will allow you to search back from your sentence to find some bold text without disrupting the first Find, something like this ..
[VBA]
:
:

Dim aRange As Range
Dim bRange As Range

:

Set aRange = ActiveDocument.Range
Set bRange = ActiveDocument.Range

:
:

aRange.Copy

bRange.End = aRange.End
bRange.Collapse wdCollapseEnd

bRange.Find.ClearFormatting
bRange.Find.Font.Bold = True
With bRange.Find
.Text = ""
.Forward = False
.Wrap = wdFindStop
.Format = True
End With
bRange.Find.Execute

aRange.Collapse wdCollapseEnd

:
:[/VBA]

[Aerogal]

Thank you very much for the example - it helped a LOT. I was able to look up your usage and pull pieces into some other code posted earlier. Frankly, I'd start from ground zero, but I'm no VBA expert, but can read code and understand the logic pretty well having programmed a long time ago.

I got a little frustrated starting in Excel because I kept getting errors with using "ActiveDocument" and "with Range.Find" (needed to define variables??) So, I pulled it over to Word, and those errors disappeared. My only issue now is that the code finds all the sentences with the first word in the array, and then all the sentences with the second word. I really need the code to read the document pulling out each sentence containing either of the two words and pasting the sentences into excel as it identifies them. There has to be an easy way to do this. If someone can point me in the right direction, I'd really appreciate it! I'll be working on it here and there because I don't have dedicated time to focus on it unfortunately. I know this is pretty simple to the experts out there. Thanks in advance.

Sub FindWordCopySentence()
Dim appExcel As Object
Dim objSheet As Object
Dim intRowCount As Integer
Const strFind As String = "shall|will" 'The words to find, each separated by '|'
Dim vFind As Variant
Dim orng As Range, oText As Range
Dim i As Long
intRowCount = 1
vFind = Split(strFind, "|")
For i = LBound(vFind) To UBound(vFind)
Set orng = ActiveDocument.Range
With orng.Find
Do While .Execute(FindText:=vFind(i))
If .Found Then
orng.Expand Unit:=wdSentence
orng.Copy
orng.Collapse wdCollapseEnd
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objSheet = appExcel.workbooks.Open("C:\Users\TEST").Sheets("Sheet1")
intRowCount = 1
End If
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
intRowCount = intRowCount + 1
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objSheet = appExcel.workbooks.Open("C:\Users\Test").Sheets("Sheet1")
intRowCount = 1
End If
End If
Loop
End With
Next
If Not objSheet Is Nothing Then
appExcel.workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
Set orng = Nothing
End Sub

[gmaxey]

Actually there isn't an easy way because unless you can define a pattern that fits the multiple terms that you want to find, VBA can only look for one thing at a time. E.g., it just can't look for Red or Blue or Green or Pink or Orange or Yellow etc

In this case there is a relatively simple pattern so try:

Sub FindWordCopySentence()
Dim oApp As Object
Dim oSheet As Object
Dim lngIndex As Long
Const strFind As String = "<[shawi]{2,3}ll>"
Dim orng As Range
lngIndex = 1
  vFind = Split(strFind, "|")
  If oSheet Is Nothing Then
    Set oApp = CreateObject("Excel.Application")
    Set oSheet = oApp.workbooks.Open("D:\Data Stores\Sentence List.xlsx").Sheets("Sheet1")
    lngIndex = 1
  End If
  Set orng = ActiveDocument.Range
    With orng.Find
      .Text = strFind
      .MatchWildcards = True
      While .Execute
        If UCase(orng.Text) = "SHALL" Or UCase(orng.Text) = "WILL" Then
          orng.Expand Unit:=wdSentence
          oSheet.Cells(lngIndex, 1).Value = orng.Text '.Select
          lngIndex = lngIndex + 1
        End If
        orng.Collapse wdCollapseEnd
     Wend
   End With
  If Not oSheet Is Nothing Then
    oApp.workbooks(1).Close True
    oApp.Quit
    Set oSheet = Nothing
    Set oApp = Nothing
  End If
  Set orng = Nothing
lbl_Exit:
  Exit Sub
End Sub

[Aerogal]

Greg, I wanted to thank you for the quick response. I've not had a chance to work on my code with your suggestion, but when I do, I'll let you know. And thanks for letting me know why all the "shalls" were found prior to the "wills." I suspected that VB could only search one item at a time with the .Find, but nice to know for certain. My code is in Word VB and I'm exporting the results to an Excel file. However, I do see how to incorporate your logic. Thanks again!

[Aerogal]

Greg, I wanted to thank you for the quick response. I've not had a chance to work on my code with your suggestion, but when I do, I'll let you know. And thanks for letting me know why all the "shalls" were found prior to the "wills." I suspected that VB could only search one item at a time with the .Find, but nice to know for certain. My code is in Word VB and I'm exporting the results to an Excel file. However, I do see how to incorporate your logic. Thanks again!

Greg -- Now that I finally have time, I hope you can help me with a little confusion I have. In the original, I see how the logic loops through the array of words to find ("strFind") by splitting up the array and searching each word at a time ("vFind") - if found, copies and pastes accordingly. The VB code works pretty well, too but only finds one word at a time (my conundrum). If you have a moment, could you help me understand the following in your code:

You Split the variable "vFind," but never use the results (why).

In the With loop, you set "orng.Find.Text" to the string variable "strFind" array contents. Walking through execution, the logic is therefore never true for the corresponding "If" statement.

Any help would be greatly appreciated. I can search for 1 word at a time. Would like to search for 2...

[gmaxey]

Aerogal,

That was just sloppiness on my part. vFind is not used and strFind is not an array but a wildcard string expression. The difficult (if not impossible part) of finding two or more different words at a time is creating a wildcard pattern that finds the desired words and excludes al others. In the code I posted earlier, I validated that regardless of what was found, only shall and will were further processed. Here is simplified version without validation. Shall and will are still processed but so is "hill, hall, wall" etc.

Sub FindTwoDifferentWords()
Const strFind As String = "<[shawi]{2,3}ll>"
Dim orng As Range
  Set orng = ActiveDocument.Range
  With orng.Find
    .Text = strFind
    .MatchWildcards = True
    'Do something globally"
    .Replacement.Font.Bold = True
    .Execute Replace:=wdReplaceAll
'Or
    'While .Execute
      'orng.Select 'Do something with the found range.
      'orng.Collapse wdCollapseEnd
    'Wend
  End With
lbl_Exit:
    Exit Sub
End Sub

[Aerogal]

Greg, Thank you. I feel very embarrassed, and your response prompted me to learn more about the wildcard feature (word.mvps.org/faqs/general/usingwildcards.htm). It is a lot more powerful than I had known only days ago.

My test document contained upper case words, so my initial macro never ended. I modified the wildcard to be:

Const strFind As String = "<[SshaWwi]{2,3}ll>"

I tested it on my test document and then a "real" document. Works like a charm. I would have never gotten this far without your help. Thank you so very much.

[gmaxey]

Aerogal,
You are welcome. Glad I could help.