VBA Word Macro freezes when exiting sub routine

L

lewkowski

I am searching though some text to break it up into name/value pairs,
the names are in bold, and the values follow, see below.
BoldName1 Value1
BoldName2 Value2
etc....

When executing the code it freezes Word when as it ends the subroutine.
I have stepped through the code and all works correctly (correctly
finding all name/value pairs) right up until End Sub which locks up
Word. Here is the code:

Dim descriptionRange As Word.Range
Dim searchRange As Word.Range
Dim tempRange As Word.Range
Dim names(100) As String
Dim values(100) As String
Dim Go As Boolean

' Select the area where the Name/Value pairs are
Selection.Find.ClearFormatting
Selection.Extend
With Selection.Find
.Text = "Execution Status :"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.HomeKey Unit:=wdLine

If Selection.Find.Found <> True Then
' Can not find
MsgBox ("could not find description block")
End If

' Store this area in a Range
Set descriptionRange = Selection.Range.Duplicate
Set searchRange = Selection.Range.Duplicate
Set tempRange = Selection.Range.Duplicate

Selection.Start = descriptionRange.Start
Selection.End = descriptionRange.End

' Find the Name/Value pairs
pairIndex = 0
Go = True
While Go
' Break up range into Name/Value pairs and insert into a table
searchRange.Find.ClearFormatting
searchRange.Find.Font.Bold = True
With searchRange.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
searchRange.Find.Execute
If searchRange.Find.Found <> True Then
Go = False
GoTo exitSearch
End If

' Get the name (In Bold)
names(pairIndex) = searchRange.Text
' Move searchRange to end of Name
searchRange.Start = searchRange.End
searchRange.End = descriptionRange.End
valueStart = searchRange.Start

' Select the rest of the Value
searchRange.Find.ClearFormatting
searchRange.Find.Font.Bold = True
With searchRange.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
searchRange.Find.Execute
If searchRange.Find.Found <> True Then
' Last item so need to take remaining text and make it the
Value
Go = False
tempRange.Start = valueStart
tempRange.End = descriptionRange.End
values(pairIndex) = tempRange.Text
GoTo exitSearch
End If
tempRange.Start = valueStart
tempRange.End = searchRange.Start
values(pairIndex) = tempRange.Text
searchRange.Start = searchRange.Start
searchRange.End = descriptionRange.End
pairIndex = pairIndex + 1
exitSearch:
Wend

End Sub
 
L

lewkowski

With further debugging it appears that the last find operation (which
doesn't find anything, which is expected) is causing the problem.
 
L

lewkowski

I have found a work around. If I set the .wrap = wdFindContinue, and
then do an extra test on the range.start and end positions to see if
the search has 'wrapped' (then exit loop), this works.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top