Find text in a word document
 

I have an Excel workbook with a range of cells that contain some text. I
need to find all instances of the text in a seperate Word document then, in
an adjacent cell on the Excel workbook, paste all the paragraph headers where
the text was found in the word document. Can anyone give me a clue??? I am
using Excel 2007 on a Windows XP Pro system.
--
DR Bellavance

Find text in a word document
 

Go to the Word Macro webpage. Moving around in the wrod document isn't
simple and it would be better to get help with the word experts.. you c an
still running the macro in excel. You need to create a wordobject in excel
using either GetObject or or Createobject and then open the word document

set Wordobj = GetObject(filename:="c:\temp\word.doc") ' put this in excel

Then reference the macro that you get from the word experts using WordObj in
front of the word macro commands.

"DR Bellavance" wrote:

I have an Excel workbook with a range of cells that contain some text. I
need to find all instances of the text in a seperate Word document then, in
an adjacent cell on the Excel workbook, paste all the paragraph headers where
the text was found in the word document. Can anyone give me a clue??? I am
using Excel 2007 on a Windows XP Pro system.
--
DR Bellavance

Find text in a word document
 

Thanks for the reply Joel. I was afraid you were going to say that but I
didn't want to post to the "Word" discussion group until the "Excel" group
had a shot at it. I am posting this query to the "Word" group under the same
heading should anyone be interested in the response.
--
DR Bellavance


"Joel" wrote:

Go to the Word Macro webpage. Moving around in the wrod document isn't
simple and it would be better to get help with the word experts.. you c an
still running the macro in excel. You need to create a wordobject in excel
using either GetObject or or Createobject and then open the word document

set Wordobj = GetObject(filename:="c:\temp\word.doc") ' put this in excel

Then reference the macro that you get from the word experts using WordObj in
front of the word macro commands.

"DR Bellavance" wrote:

I have an Excel workbook with a range of cells that contain some text. I
need to find all instances of the text in a seperate Word document then, in
an adjacent cell on the Excel workbook, paste all the paragraph headers where
the text was found in the word document. Can anyone give me a clue??? I am
using Excel 2007 on a Windows XP Pro system.
--
DR Bellavance

Find text in a word document
 

Here is the excel portion of the code.

Sub GetParagraphs()

Set WordList = Sheets("Sheet1").Range("A1:A100")
Set ParagraphTitle = Sheets("Sheet2")

filetoOpen = Application _
.GetOpenFilename("Word Files (*.doc), *.doc")
If filetoOpen = False Then
MsgBox ("Cannot Open File - Exiting Macro")
Exit Sub
End If

Set WordObj = GetObject(pathname:=filetoOpen)
WordObj.Application.Visible = True

ParRowCount = 1
For Each Word In WordList
'Enter Word Search code here
'ParTitle = "text found in word"
ParagraphTitle.Range("A" & ParRowCount) = ParTitle
ParRowCount = ParRowCount + 1
Next Word

WordObj.Application.Quit
End Sub


"DR Bellavance" wrote:

Thanks for the reply Joel. I was afraid you were going to say that but I
didn't want to post to the "Word" discussion group until the "Excel" group
had a shot at it. I am posting this query to the "Word" group under the same
heading should anyone be interested in the response.
--
DR Bellavance


"Joel" wrote:

Go to the Word Macro webpage. Moving around in the wrod document isn't
simple and it would be better to get help with the word experts.. you c an
still running the macro in excel. You need to create a wordobject in excel
using either GetObject or or Createobject and then open the word document

set Wordobj = GetObject(filename:="c:\temp\word.doc") ' put this in excel

Then reference the macro that you get from the word experts using WordObj in
front of the word macro commands.

"DR Bellavance" wrote:

I have an Excel workbook with a range of cells that contain some text. I
need to find all instances of the text in a seperate Word document then, in
an adjacent cell on the Excel workbook, paste all the paragraph headers where
the text was found in the word document. Can anyone give me a clue??? I am
using Excel 2007 on a Windows XP Pro system.
--
DR Bellavance

Find text in a word document
 

Here is the excel portion of the code.

Sub GetParagraphs()

Set WordList = Sheets("Sheet1").Range("A1:A100")
Set ParagraphTitle = Sheets("Sheet2")

filetoOpen = Application _
.GetOpenFilename("Word Files (*.doc), *.doc")
If filetoOpen = False Then
MsgBox ("Cannot Open File - Exiting Macro")
Exit Sub
End If

Set WordObj = GetObject(pathname:=filetoOpen)
WordObj.Application.Visible = True

ParRowCount = 1
For Each Word In WordList
'Enter Word Search code here
'ParTitle = "text found in word"
ParagraphTitle.Range("A" & ParRowCount) = ParTitle
ParRowCount = ParRowCount + 1
Next Word

WordObj.Application.Quit
End Sub


"DR Bellavance" wrote:

Thanks for the reply Joel. I was afraid you were going to say that but I
didn't want to post to the "Word" discussion group until the "Excel" group
had a shot at it. I am posting this query to the "Word" group under the same
heading should anyone be interested in the response.
--
DR Bellavance


"Joel" wrote:

Go to the Word Macro webpage. Moving around in the wrod document isn't
simple and it would be better to get help with the word experts.. you c an
still running the macro in excel. You need to create a wordobject in excel
using either GetObject or or Createobject and then open the word document

set Wordobj = GetObject(filename:="c:\temp\word.doc") ' put this in excel

Then reference the macro that you get from the word experts using WordObj in
front of the word macro commands.

"DR Bellavance" wrote:

I have an Excel workbook with a range of cells that contain some text. I
need to find all instances of the text in a seperate Word document then, in
an adjacent cell on the Excel workbook, paste all the paragraph headers where
the text was found in the word document. Can anyone give me a clue??? I am
using Excel 2007 on a Windows XP Pro system.
--
DR Bellavance

Find text in a word document
 

Thanks for the prompt reply. After spending several days with the
KnowledgeBase, Excel and Word books it turns out that this is not a simple
question. When trying to execute a "find" in the word document from an Excel
Macro, the find did not execute and the returned "Find" results was always
blank. After conversing with the experts in the "Word Programming" forum,
their answer was to copy the text I whish to searh for into a seperate text
or word document and perform the "Find" using a Macro written for "Word".
This seemed to labor intensive for the function I wished to perform so I came
up with a third alternative which is to use a function written for the word
document and call the word function from excel. the code I use seems to work
so I thought I'd put it in here in case anyone would like to use it or
scrutinize it for a more elegant approach.

Here is the Excel Macro....
##########################################
Sub SearchForText()
'
' SearchForText Macro
'
'
Dim WordApp As Word.Application
Dim wordDoc As Document
Dim WordWasNotRunning As Boolean
Dim inRange As Range
Dim srcCell As Range
Dim srchResults As String
Dim srchStr As String
Dim tmp As Variant

WordWasNotRunning = False

'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")

If Err Then
Set WordApp = New Word.Application
WordWasNotRunning = True
End If

On Error GoTo Err_Handler

WordApp.Visible = True
WordApp.Activate
WordApp.Application.ScreenUpdating = False

Set wordDoc = WordApp.Documents.Open("C:\MyPath\MyDoc.docx",
ReadOnly:=True)

On Error Resume Next

Set inRange = Worksheets(ActiveSheet.Name).Range("C2:C376")
inRange.Cells.Offset(0, 7).Value = ""
inRange.Cells.Offset(0, 7).Interior.ColorIndex = xlNone

For Each srcCell In inRange.Cells
srchResults = WordApp.Run("TextInstanceFind", srcCell.Text)
If srchResults = "" Then
srcCell.Offset(0, 7).Interior.Color = RGB(149, 55, 53)
Else
srcCell.Offset(0, 7).Value = srchResults
End If
Next srcCell

'Close the document
wordDoc.Close savechanges:=wdDoNotSaveChanges

If WordWasNotRunning Then
'Close Word
WordApp.Quit
End If

Set wordDoc = Nothing
Set WordApp = Nothing
Exit Sub

Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error:
" & Err.Number
If WordWasNotRunning Then
WordApp.Quit
End If

End Sub

And here is the Word Function....
##########################################
Function TextInstanceFind(srchStr As String) As String
'
' TextInstanceFindFunction
'
'
Dim foundStr As String

Selection.Start = 1
Selection.End = Selection.Start
Selection.Find.ClearFormatting
With Selection.Find
.Text = srchStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
While Selection.Find.Execute = True
' Move to the previous section to find out if the requirement in in a
' requirement list or in a procedure
Selection.MoveLeft
Selection.MoveLeft Unit:=wdCell, Count:=1
If Selection.Text = "Text that indicates that this selection should
be skipped" Then
'This is the wrong selection go to the next
Selection.MoveLeft
Selection.MoveRight Unit:=wdCell, Count:=1
If Selection.End Then
Selection.Start = Selection.End
End If
Else
'This is the correct selection. Go find the heading before
Selection.MoveLeft
Selection.Find.Text = ""
Selection.Find.Style = "Heading 5"
Selection.Find.Forward = False
Selection.Find.Execute

If foundStr = "" Then
foundStr = Selection.Range.ListFormat.ListString
Else
foundStr = foundStr + ", " +
Selection.Range.ListFormat.ListString
End If

' Get the heading number
Selection.Start = Selection.End
Selection.Find.Forward = True
If Selection.Find.Execute = False Then
Selection.Start = Selection.End
Selection.Find.Text = srchStr
Selection.Find.Style = "Normal"
Selection.Find.Forward = True
Selection.Find.Execute
Selection.Start = Selection.End
Else
Selection.MoveLeft
Selection.Find.Text = srchStr
Selection.Find.Style = "Normal"
Selection.Find.Forward = True
End If
End If
'No go to the end of the section and set up the next search
Wend
TextInstanceFind = foundStr
End Function
#######################################

The performance isn't great but it sure saves a lot of cut and paste. If
there is a way to enhance this, please let me know.

--
DR Bellavance


"Joel" wrote:

Here is the excel portion of the code.

Sub GetParagraphs()

Set WordList = Sheets("Sheet1").Range("A1:A100")
Set ParagraphTitle = Sheets("Sheet2")

filetoOpen = Application _
.GetOpenFilename("Word Files (*.doc), *.doc")
If filetoOpen = False Then
MsgBox ("Cannot Open File - Exiting Macro")
Exit Sub
End If

Set WordObj = GetObject(pathname:=filetoOpen)
WordObj.Application.Visible = True

ParRowCount = 1
For Each Word In WordList
'Enter Word Search code here
'ParTitle = "text found in word"
ParagraphTitle.Range("A" & ParRowCount) = ParTitle
ParRowCount = ParRowCount + 1
Next Word

WordObj.Application.Quit
End Sub


"DR Bellavance" wrote:

Thanks for the reply Joel. I was afraid you were going to say that but I
didn't want to post to the "Word" discussion group until the "Excel" group
had a shot at it. I am posting this query to the "Word" group under the same
heading should anyone be interested in the response.
--
DR Bellavance


"Joel" wrote:

Go to the Word Macro webpage. Moving around in the wrod document isn't
simple and it would be better to get help with the word experts.. you c an
still running the macro in excel. You need to create a wordobject in excel
using either GetObject or or Createobject and then open the word document

set Wordobj = GetObject(filename:="c:\temp\word.doc") ' put this in excel

Then reference the macro that you get from the word experts using WordObj in
front of the word macro commands.

"DR Bellavance" wrote:

I have an Excel workbook with a range of cells that contain some text. I
need to find all instances of the text in a seperate Word document then, in
an adjacent cell on the Excel workbook, paste all the paragraph headers where
the text was found in the word document. Can anyone give me a clue??? I am
using Excel 2007 on a Windows XP Pro system.
--
DR Bellavance

Find text in a word document
 

The word part I knew would be tricky. I don't know why you need to put the
word function in a word document. You should be able to do like I did below.

Sub SearchForText()
'
' SearchForText Macro
'
'
Dim WordApp As Word.Application
Dim wordDoc As Document
Dim WordWasNotRunning As Boolean
Dim inRange As Range
Dim srcCell As Range
Dim srchResults As String
Dim srchStr As String
Dim tmp As Variant

WordWasNotRunning = False

'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")

If Err Then
Set WordApp = New Word.Application
WordWasNotRunning = True
End If

On Error GoTo Err_Handler

WordApp.Visible = True
WordApp.Activate
WordApp.Application.ScreenUpdating = False

Set wordDoc = WordApp.Documents.Open( _
"C:\MyPath\MyDoc.docx", ReadOnly:=True)

On Error Resume Next

Set inRange = Worksheets(ActiveSheet.Name).Range("C2:C376")
inRange.Cells.Offset(0, 7).Value = ""
inRange.Cells.Offset(0, 7).Interior.ColorIndex = xlNone

For Each srcCell In inRange.Cells
srchResults = TextInstanceFind(wordDoc, srcCell.Text)
If srchResults = "" Then
srcCell.Offset(0, 7).Interior.Color = RGB(149, 55, 53)
Else
srcCell.Offset(0, 7).Value = srchResults
End If
Next srcCell

'Close the document
wordDoc.Close savechanges:=wdDoNotSaveChanges

If WordWasNotRunning Then
'Close Word
WordApp.Quit
End If

Set wordDoc = Nothing
Set WordApp = Nothing
Exit Sub

Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, _
vbCritical, "Error: " & Err.Number
If WordWasNotRunning Then
WordApp.Quit
End If

End Sub

Function TextInstanceFind(Doc As Variant, _
srchStr As String) As String
'
' TextInstanceFindFunction
'
'
Dim foundStr As String
With Doc
.Selection.Start = 1
.Selection.End = Selection.Start
.Selection.Find.ClearFormatting
With .Selection.Find
.Text = srchStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
While .Selection.Find.Execute = True
' Move to the previous section to find out if the requirement in in a
' requirement list or in a procedure
.Selection.MoveLeft
.Selection.MoveLeft Unit:=wdCell, Count:=1
If .Selection.Text = _
"Text that indicates that this selection should be skipped" Then
'This is the wrong selection go to the next
.Selection.MoveLeft
.Selection.MoveRight Unit:=wdCell, Count:=1
If .Selection.End Then
.Selection.Start = Selection.End
End If
Else
'This is the correct selection. Go find the heading before
.Selection.MoveLeft
.Selection.Find.Text = ""
.Selection.Find.Style = "Heading 5"
.Selection.Find.Forward = False
.Selection.Find.Execute

If foundStr = "" Then
foundStr = .Selection.Range.ListFormat.ListString
Else
foundStr = foundStr + ", " + _
.Selection.Range.ListFormat.ListString
End If

' Get the heading number
.Selection.Start = .Selection.End
.Selection.Find.Forward = True
If .Selection.Find.Execute = False Then
.Selection.Start = Selection.End
.Selection.Find.Text = srchStr
.Selection.Find.Style = "Normal"
.Selection.Find.Forward = True
.Selection.Find.Execute
.Selection.Start = Selection.End
Else
.Selection.MoveLeft
.Selection.Find.Text = srchStr
.Selection.Find.Style = "Normal"
.Selection.Find.Forward = True
End If
End If
'No go to the end of the section and set up the next search
Wend
TextInstanceFind = foundStr
End With
End Function



"DR Bellavance" wrote:

Thanks for the prompt reply. After spending several days with the
KnowledgeBase, Excel and Word books it turns out that this is not a simple
question. When trying to execute a "find" in the word document from an Excel
Macro, the find did not execute and the returned "Find" results was always
blank. After conversing with the experts in the "Word Programming" forum,
their answer was to copy the text I whish to searh for into a seperate text
or word document and perform the "Find" using a Macro written for "Word".
This seemed to labor intensive for the function I wished to perform so I came
up with a third alternative which is to use a function written for the word
document and call the word function from excel. the code I use seems to work
so I thought I'd put it in here in case anyone would like to use it or
scrutinize it for a more elegant approach.

Here is the Excel Macro....
##########################################
Sub SearchForText()
'
' SearchForText Macro
'
'
Dim WordApp As Word.Application
Dim wordDoc As Document
Dim WordWasNotRunning As Boolean
Dim inRange As Range
Dim srcCell As Range
Dim srchResults As String
Dim srchStr As String
Dim tmp As Variant

WordWasNotRunning = False

'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")

If Err Then
Set WordApp = New Word.Application
WordWasNotRunning = True
End If

On Error GoTo Err_Handler

WordApp.Visible = True
WordApp.Activate
WordApp.Application.ScreenUpdating = False

Set wordDoc = WordApp.Documents.Open("C:\MyPath\MyDoc.docx",
ReadOnly:=True)

On Error Resume Next

Set inRange = Worksheets(ActiveSheet.Name).Range("C2:C376")
inRange.Cells.Offset(0, 7).Value = ""
inRange.Cells.Offset(0, 7).Interior.ColorIndex = xlNone

For Each srcCell In inRange.Cells
srchResults = WordApp.Run("TextInstanceFind", srcCell.Text)
If srchResults = "" Then
srcCell.Offset(0, 7).Interior.Color = RGB(149, 55, 53)
Else
srcCell.Offset(0, 7).Value = srchResults
End If
Next srcCell

'Close the document
wordDoc.Close savechanges:=wdDoNotSaveChanges

If WordWasNotRunning Then
'Close Word
WordApp.Quit
End If

Set wordDoc = Nothing
Set WordApp = Nothing
Exit Sub

Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error:
" & Err.Number
If WordWasNotRunning Then
WordApp.Quit
End If

End Sub

And here is the Word Function....
##########################################
Function TextInstanceFind(srchStr As String) As String
'
' TextInstanceFindFunction
'
'
Dim foundStr As String

Selection.Start = 1
Selection.End = Selection.Start
Selection.Find.ClearFormatting
With Selection.Find
.Text = srchStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
While Selection.Find.Execute = True
' Move to the previous section to find out if the requirement in in a
' requirement list or in a procedure
Selection.MoveLeft
Selection.MoveLeft Unit:=wdCell, Count:=1
If Selection.Text = "Text that indicates that this selection should
be skipped" Then
'This is the wrong selection go to the next
Selection.MoveLeft
Selection.MoveRight Unit:=wdCell, Count:=1
If Selection.End Then
Selection.Start = Selection.End
End If
Else
'This is the correct selection. Go find the heading before
Selection.MoveLeft
Selection.Find.Text = ""
Selection.Find.Style = "Heading 5"
Selection.Find.Forward = False
Selection.Find.Execute

If foundStr = "" Then
foundStr = Selection.Range.ListFormat.ListString
Else
foundStr = foundStr + ", " +
Selection.Range.ListFormat.ListString
End If

' Get the heading number
Selection.Start = Selection.End
Selection.Find.Forward = True
If Selection.Find.Execute = False Then
Selection.Start = Selection.End
Selection.Find.Text = srchStr
Selection.Find.Style = "Normal"
Selection.Find.Forward = True
Selection.Find.Execute
Selection.Start = Selection.End
Else
Selection.MoveLeft
Selection.Find.Text = srchStr
Selection.Find.Style = "Normal"
Selection.Find.Forward = True
End If
End If
'No go to the end of the section and set up the next search
Wend
TextInstanceFind = foundStr
End Function
#######################################

The performance isn't great but it sure saves a lot of cut and paste. If
there is a way to enhance this, please let me know.

--
DR Bellavance


"Joel" wrote:

Here is the excel portion of the code.

Sub GetParagraphs()

Set WordList = Sheets("Sheet1").Range("A1:A100")
Set ParagraphTitle = Sheets("Sheet2")

filetoOpen = Application _
.GetOpenFilename("Word Files (*.doc), *.doc")
If filetoOpen = False Then
MsgBox ("Cannot Open File - Exiting Macro")
Exit Sub
End If

Set WordObj = GetObject(pathname:=filetoOpen)
WordObj.Application.Visible = True

ParRowCount = 1
For Each Word In WordList
'Enter Word Search code here
'ParTitle = "text found in word"
ParagraphTitle.Range("A" & ParRowCount) = ParTitle
ParRowCount = ParRowCount + 1
Next Word

WordObj.Application.Quit
End Sub


"DR Bellavance" wrote:

Thanks for the reply Joel. I was afraid you were going to say that but I
didn't want to post to the "Word" discussion group until the "Excel" group
had a shot at it. I am posting this query to the "Word" group under the same
heading should anyone be interested in the response.
--
DR Bellavance


"Joel" wrote:

Go to the Word Macro webpage. Moving around in the wrod document isn't
simple and it would be better to get help with the word experts.. you c an
still running the macro in excel. You need to create a wordobject in excel
using either GetObject or or Createobject and then open the word document

set Wordobj = GetObject(filename:="c:\temp\word.doc") ' put this in excel

Then reference the macro that you get from the word experts using WordObj in
front of the word macro commands.

"DR Bellavance" wrote:

I have an Excel workbook with a range of cells that contain some text. I
need to find all instances of the text in a seperate Word document then, in
an adjacent cell on the Excel workbook, paste all the paragraph headers where
the text was found in the word document. Can anyone give me a clue??? I am
using Excel 2007 on a Windows XP Pro system.
--
DR Bellavance

Find text in a word document
 

Thanks Joel for the idea. Unfortunately when I made the change, the passing
of the wordDoc parameter failed (the "Doc" parameter just had the filename as
a value) and the call to the local function fails on the first library call
(Selection.Start = 1). When I tried to place all of the code in the macro so
there was no function call, all of the library calls worked with the
exception of the Find.execute. This call still will not actually perform a
find in the document and the results is always an empty string. If there is
a way to solve this, please let me know.

--
DR Bellavance


"Joel" wrote:

The word part I knew would be tricky. I don't know why you need to put the
word function in a word document. You should be able to do like I did below.

Sub SearchForText()
'
' SearchForText Macro
'
'
Dim WordApp As Word.Application
Dim wordDoc As Document
Dim WordWasNotRunning As Boolean
Dim inRange As Range
Dim srcCell As Range
Dim srchResults As String
Dim srchStr As String
Dim tmp As Variant

WordWasNotRunning = False

'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")

If Err Then
Set WordApp = New Word.Application
WordWasNotRunning = True
End If

On Error GoTo Err_Handler

WordApp.Visible = True
WordApp.Activate
WordApp.Application.ScreenUpdating = False

Set wordDoc = WordApp.Documents.Open( _
"C:\MyPath\MyDoc.docx", ReadOnly:=True)

On Error Resume Next

Set inRange = Worksheets(ActiveSheet.Name).Range("C2:C376")
inRange.Cells.Offset(0, 7).Value = ""
inRange.Cells.Offset(0, 7).Interior.ColorIndex = xlNone

For Each srcCell In inRange.Cells
srchResults = TextInstanceFind(wordDoc, srcCell.Text)
If srchResults = "" Then
srcCell.Offset(0, 7).Interior.Color = RGB(149, 55, 53)
Else
srcCell.Offset(0, 7).Value = srchResults
End If
Next srcCell

'Close the document
wordDoc.Close savechanges:=wdDoNotSaveChanges

If WordWasNotRunning Then
'Close Word
WordApp.Quit
End If

Set wordDoc = Nothing
Set WordApp = Nothing
Exit Sub

Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, _
vbCritical, "Error: " & Err.Number
If WordWasNotRunning Then
WordApp.Quit
End If

End Sub

Function TextInstanceFind(Doc As Variant, _
srchStr As String) As String
'
' TextInstanceFindFunction
'
'
Dim foundStr As String
With Doc
.Selection.Start = 1
.Selection.End = Selection.Start
.Selection.Find.ClearFormatting
With .Selection.Find
.Text = srchStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
While .Selection.Find.Execute = True
' Move to the previous section to find out if the requirement in in a
' requirement list or in a procedure
.Selection.MoveLeft
.Selection.MoveLeft Unit:=wdCell, Count:=1
If .Selection.Text = _
"Text that indicates that this selection should be skipped" Then
'This is the wrong selection go to the next
.Selection.MoveLeft
.Selection.MoveRight Unit:=wdCell, Count:=1
If .Selection.End Then
.Selection.Start = Selection.End
End If
Else
'This is the correct selection. Go find the heading before
.Selection.MoveLeft
.Selection.Find.Text = ""
.Selection.Find.Style = "Heading 5"
.Selection.Find.Forward = False
.Selection.Find.Execute

If foundStr = "" Then
foundStr = .Selection.Range.ListFormat.ListString
Else
foundStr = foundStr + ", " + _
.Selection.Range.ListFormat.ListString
End If

' Get the heading number
.Selection.Start = .Selection.End
.Selection.Find.Forward = True
If .Selection.Find.Execute = False Then
.Selection.Start = Selection.End
.Selection.Find.Text = srchStr
.Selection.Find.Style = "Normal"
.Selection.Find.Forward = True
.Selection.Find.Execute
.Selection.Start = Selection.End
Else
.Selection.MoveLeft
.Selection.Find.Text = srchStr
.Selection.Find.Style = "Normal"
.Selection.Find.Forward = True
End If
End If
'No go to the end of the section and set up the next search
Wend
TextInstanceFind = foundStr
End With
End Function



"DR Bellavance" wrote:

Thanks for the prompt reply. After spending several days with the
KnowledgeBase, Excel and Word books it turns out that this is not a simple
question. When trying to execute a "find" in the word document from an Excel
Macro, the find did not execute and the returned "Find" results was always
blank. After conversing with the experts in the "Word Programming" forum,
their answer was to copy the text I whish to searh for into a seperate text
or word document and perform the "Find" using a Macro written for "Word".
This seemed to labor intensive for the function I wished to perform so I came
up with a third alternative which is to use a function written for the word
document and call the word function from excel. the code I use seems to work
so I thought I'd put it in here in case anyone would like to use it or
scrutinize it for a more elegant approach.

Here is the Excel Macro....
##########################################
Sub SearchForText()
'
' SearchForText Macro
'
'
Dim WordApp As Word.Application
Dim wordDoc As Document
Dim WordWasNotRunning As Boolean
Dim inRange As Range
Dim srcCell As Range
Dim srchResults As String
Dim srchStr As String
Dim tmp As Variant

WordWasNotRunning = False

'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")

If Err Then
Set WordApp = New Word.Application
WordWasNotRunning = True
End If

On Error GoTo Err_Handler

WordApp.Visible = True
WordApp.Activate
WordApp.Application.ScreenUpdating = False

Set wordDoc = WordApp.Documents.Open("C:\MyPath\MyDoc.docx",
ReadOnly:=True)

On Error Resume Next

Set inRange = Worksheets(ActiveSheet.Name).Range("C2:C376")
inRange.Cells.Offset(0, 7).Value = ""
inRange.Cells.Offset(0, 7).Interior.ColorIndex = xlNone

For Each srcCell In inRange.Cells
srchResults = WordApp.Run("TextInstanceFind", srcCell.Text)
If srchResults = "" Then
srcCell.Offset(0, 7).Interior.Color = RGB(149, 55, 53)
Else
srcCell.Offset(0, 7).Value = srchResults
End If
Next srcCell

'Close the document
wordDoc.Close savechanges:=wdDoNotSaveChanges

If WordWasNotRunning Then
'Close Word
WordApp.Quit
End If

Set wordDoc = Nothing
Set WordApp = Nothing
Exit Sub

Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error:
" & Err.Number
If WordWasNotRunning Then
WordApp.Quit
End If

End Sub

And here is the Word Function....
##########################################
Function TextInstanceFind(srchStr As String) As String
'
' TextInstanceFindFunction
'
'
Dim foundStr As String

Selection.Start = 1
Selection.End = Selection.Start
Selection.Find.ClearFormatting
With Selection.Find
.Text = srchStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
While Selection.Find.Execute = True
' Move to the previous section to find out if the requirement in in a
' requirement list or in a procedure
Selection.MoveLeft
Selection.MoveLeft Unit:=wdCell, Count:=1
If Selection.Text = "Text that indicates that this selection should
be skipped" Then
'This is the wrong selection go to the next
Selection.MoveLeft
Selection.MoveRight Unit:=wdCell, Count:=1
If Selection.End Then
Selection.Start = Selection.End
End If
Else
'This is the correct selection. Go find the heading before
Selection.MoveLeft
Selection.Find.Text = ""
Selection.Find.Style = "Heading 5"
Selection.Find.Forward = False
Selection.Find.Execute

If foundStr = "" Then
foundStr = Selection.Range.ListFormat.ListString
Else
foundStr = foundStr + ", " +
Selection.Range.ListFormat.ListString
End If

' Get the heading number
Selection.Start = Selection.End
Selection.Find.Forward = True
If Selection.Find.Execute = False Then
Selection.Start = Selection.End
Selection.Find.Text = srchStr
Selection.Find.Style = "Normal"
Selection.Find.Forward = True
Selection.Find.Execute
Selection.Start = Selection.End
Else
Selection.MoveLeft