Macro which does not stop

[Jerry]

I have a macro (pasted below) that searches for any
occurance of 2 styles in a row. In this case the
style "term". It then highlights the ones that it finds so
ic an easily spot it. The problem being is that when the
last style in the document is "term", the macro does not
stop. I am sure I am missing something basic here.

Thanks for your help

Sub XMLDoubleTerm()
Dim oRng As Range
With Selection
.HomeKey Unit:=wdStory
With .Find
.text = ""
.Style = "term"
Do While .Execute
Set oRng = Selection.Range
With oRng
Do Until .Paragraphs.Last.Range.Style
<> "term"
.MoveEnd Unit:=wdParagraph, Count:=1
Loop
.MoveEnd Unit:=wdParagraph, Count:=-1
If .Paragraphs.Count > 1 Then
.HighlightColorIndex = wdYellow
End If
End With
Loop
End With
End With
End Sub

 

[Greg]

Jerry,

The continous loop was due to the lines:

Do Until .Paragraphs.Last.Range.Style <> "term"
.MoveEnd Unit:=wdParagraph, Count:=1
Loop

Try the following to break out of that loop:

Sub XMLDoubleterm()
Dim oRng As Range
Dim i As Long
i = ActiveDocument.Paragraphs.Count
With Selection
.HomeKey Unit:=wdStory
With .Find
.Text = ""
.Style = "term"
Do While .Execute
Set oRng = Selection.Range
With oRng
Do Until oRng.End = ActiveDocument.Range.End Or
..Paragraphs.Last.Range.Style <> "term"
.MoveEnd Unit:=wdParagraph, Count:=1
Loop
If oRng.End < ActiveDocument.Range.End Then
.MoveEnd Unit:=wdParagraph, Count:=-1
End If
If .Paragraphs.Count > 1 Then
.HighlightColorIndex = wdYellow
End If
End With
Loop
End With
End With
End Sub