Restrict Find to specific range in a document

[Eddy Beuckelaers]

I have to search the first cell of the first table in each section of a
multi-section document for words in Arial Black.

I tried code like this:

With doc.Sections(intSection).Range.Tables(1).Cell(1, 1).Range.Find
.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Font.Name = "Arial Black"

Do While .Execute
strTag = .Parent.Text
...
Loop
End With

If the cell doesn't contain Arial Black, all is ok. Find doesn't go beyond
the cell. But when it does contain a word in Arial Black, the first
occurence is correctly passed to the variable, but subsequent Executes in
the loop go beyond the cell boundaries. I understand this is because Execute
redefines the range to the text found when successfull.

I can make the loop work with below changes, basically checking is the found
range is still withing the same cell. But that makes the algorithm
unacceptably slow. I realize I can optimize the loop by not evaluating all
four Information data when the first ones fail, but my solution seems so
complicated for a not so far fetched task. Any other ideas?

Tx,
Eddy.

Set rngWordFind = doc.Sections(intSection).Range.Tables(1).Cell(1, 1).Range
With rngWordFind.Find
.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Font.Name = "Arial Black"
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

Do While .Execute
blnInfoWithinTable = rngWordFind.Information(wdWithInTable)
intInfoSection = rngWordFind.Information(wdActiveEndSectionNumber)
intInfoCol = rngWordFind.Information(wdStartOfRangeColumnNumber)
intInfoRow = rngWordFind.Information(wdStartOfRangeRowNumber)

If blnInfoWithinTable = True And intInfoSection = intSection And
intInfoRow = 1 And intInfoCol = 2 Then
strTag = rngWordFind.Find.Parent.Text
Else
Exit Do
End If
Loop
End With

 

[Doug Robbins - Word MVP]

This may do what you want:

Dim myrange As Range
Dim strTag As String
Dim i As Long
With ActiveDocument
For i = 1 To .Sections.Count
Set myrange = .Sections(i).Range.Tables(1).Cell(1, 1).Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Font.Name = "Arial Black"
With Selection.Find
Do While .Execute(Findtext:="", Forward:=True,
MatchWildcards:=False, Wrap:=wdFindStop) = True
If Selection.Range.Start >= myrange.Start And
Selection.Range.End <= myrange.End Then
strTag = Selection.Range
'do something with strTag
End If
Loop
End With
Next i
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Eddy Beuckelaers]

Tx Doug, you pointed me in the right direction. Optimized some further
though. More than 20 times faster now!

I'm not using the selection object, but a second range object.
And isn't it so that your Selection.HomeKey wdStory restarts the search at
the beginning every pass of the loop. I think it's slightly more efficient
to start directly from the target range (in this case a single cell in a
table) a stopping as soon as the start of the find range is beyond the end
of the original target cell?

Set rngSingleCell = .Sections(intSection).Range.Tables(1).Cell(1, 2).Range
Set rngWordFind = .Sections(intSection).Range.Tables(1).Cell(1, 2).Range

With rngWordFind.Find
.ClearFormatting
.Text = ""
.Forward = True
.Format = True
.Font.Name = "Arial Black"

Do While .Execute
If rngSingleCell.End < rngWordFind.Start Then 'match found beyond
single cell
Exit Do
Else
strNorm = Trim(.Parent.Text)
...
End If
Loop
End With

Tx again,
Eddy.