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
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