Replacing Paragraph causes it to go into Infinite loop

Question

I need to proccess text by paragraphs. Next example shows taking a paragraph and removing its last character - the paragraph character. Then I proccess this text and try to replace old text with a new one. The problem is that it goes into infinite loop and freezes Word.

Sub Parser()
    For Each para In ActiveDocument.Paragraphs
        If Len(para.Range.Text) >= 150 Then
            
            CleanedString = Left(para.Range.Text, Len(para.Range.Text) - 1)
            'Some proccessing here
            para.Range.Text = CleanedString & vbCr
        End If
    Next
End Sub

I also tried removing all the paragraphs and placing them back after processing, but it also failed.

Answer 1

Its an infinite loop because you are adding a new paragraph to the end of your text. Consequently every time you process a string the document gets 1 paragraph longer. The trick is to adjust the range before you process the text.

Sub Parser()
    For Each para In ActiveDocument.Paragraphs

        para.range.moveend unit:=wdcharacter, count =-1
        If Len(para.Range.Text) >= 150 Then
            
            CleanedString = para.Range.Text
            'Some proccessing here
            para.Range.Text = CleanedString
        End If
    Next
End Sub

Answer 2

Right solution was near, thanks @freeflow. I acutally needed to wrap it into With

For Each para In ActiveDocument.Paragraphs
    If Len(para.Range.Text) >= 150 Then
        With para.Range
            .MoveEnd Unit:=wdCharacter, Count:=-1
            NewText = .Text
            .Text = NewText
        End With
    End If
Next