Thank you very much Andrew, for the reply. I tried to redefine the rng each time as you did but it still replaces the whole document below the selection. The rng collapses mainly on the 4th item after passing .Execute Replace:=wdReplaceAll before this line the rng was the original range. But when the code passes this line on the 4th item I got the rng = "". I couldn't find any explainable reason on the internet so I tried the following code of line temporarily

Code:
If i = 4 Then
.Execute Replace:=wdReplaceOne
Else
.Execute Replace:=wdReplaceAll
End If