Looping problem

[Amy]

Hi, I created this from some of the comments posted here.
Why does the "For Each...Next" loop through the whole document and not just
the selection?

Sub NumSR()

Dim rSlc As Range ' selection range
Dim rTmp As Range ' temporary range
Dim oPrg As Paragraph
Set rSlc = Selection.Range

For Each oPrg In rSlc.Paragraphs
Set rTmp = oPrg.Range
With rTmp.Find
.Text = "([^32^t^s]{1,})^13"
.MatchWildcards = True
.Execute
End With

If rTmp.Find.Found Then
With rTmp.Find
.Text = "([^32^t^s]{1,})^13"
.Replacement.Text = "^t^p"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End If

With rTmp.Find
.Text = "([0-9]{1,})([^32^t^s]{1,})^13"
.MatchWildcards = True
.Execute
End With

If rTmp.Find.Found Then
With rTmp.Find
.Text = "([0-9]{1,})([^32^t^s]{1,})^13"
.Replacement.Text = "^p"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End If

With rTmp.Find
.Text = "([0-9]{1,})^13"
.MatchWildcards = True
.Execute
End With

If rTmp.Find.Found Then
With rTmp.Find
.Text = "([0-9]{1,})^13"
.Replacement.Text = "^p"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End If

Next

Dim i As Long
With rSlc
For i = 1 To .Paragraphs.Count
Set rTmp = .Paragraphs(i).Range
rTmp.End = rTmp.End - 1
rTmp.Text = rTmp.Text & i
Next i
End With

End Sub

 

[Helmut Weber]

Hi Amy

Why does the "For Each...Next" loop through the whole document
and not just the selection?

Using ranges can sometimes be hairy.
The range is first contracted to the found text.
Then, depending on what you do to the found text,
it expands again from the found spot to the end of the doc,
or it stays where it is.

Add rTmp.select for testing
before and after the replacement
and see what happens.

Without being able to explain all,
this might cure your problem:

Sub NumSRx()

Dim rSlc As Range ' selection range
Dim rTmp As Range ' temporary range
Dim oPrg As Paragraph
Set rSlc = selection.Range

For Each oPrg In rSlc.Paragraphs
Set rTmp = oPrg.Range
With rTmp.Find
.Text = "([^32^t^s]{1,})^13"
.Replacement.Text = "^t^p"
.MatchWildcards = True
.Execute Replace:=wdReplaceOne
End With
Set rTmp = oPrg.Range
With rTmp.Find
.Text = "([0-9]{1,})([^32^t^s]{1,})^13"
.Replacement.Text = "^p"
.MatchWildcards = True
.Execute Replace:=wdReplaceOne
End With
Next

End Sub

By the way, the first find and replace is redundant here.
The second alone would do it all.

HTH

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"