Search and replace within selection

Hello everyone,

I'm having some problems getting a search and replace function going. What I want to achieve is a function that replaces all occurrences of a text within a table cell (that I have already selected) except if the text is part of a bulleted list.

This is what I have come up with so far:

Code:

---

Public Sub Replace2()
    Dim rDcm As Range
    ' Set rDcm = ActiveDocument.Range
    Set rDcm = Selection.Range
    With rDcm.Find
    .Text = "long"
    Do While .Execute
        If rDcm.ListFormat.ListType <> wdListBullet Then
            rDcm.Text = "short"
            ' rDcm.Collapse wdCollapseEnd
        End If
    Loop
    End With
End Sub

---

The problem with this one is that it only replaces the first instance of the word in the cell, even though it's inside the while execute loop. :think:

I've also tried another approach but this changes the selection so it will also replace instances outside of the selected cell.

Code:

---

Public Sub Replace4()
    With Selection.Find
    .Text = "long"
    Do While .Execute
        If Selection.Range.ListFormat.ListType <> wdListBullet Then
            Selection.Range.Text = "short"
            ' Chr(11)
            ' Chr (13) + Chr(10)
            ' rDcm.Collapse wdCollapseEnd
        End If
    Loop
    End With
End Sub

---

Any suggestions would be very welcome.

I found a possible solution:

Code:

---

Public Sub Replace4()
    Dim startRow As Integer
    startRow = Selection.Range.Information(wdEndOfRangeRowNumber)
    With Selection.Find
    .Text = "long"
    Do While .Execute
        If Selection.Range.Information(wdEndOfRangeRowNumber) <> startRow Then
            Exit Do
        End If
        If Selection.Range.ListFormat.ListType <> wdListBullet Then
            Selection.Range.Text = "short"
            ' Chr(11)
            ' Chr (13) + Chr(10)
            ' rDcm.Collapse wdCollapseEnd
        End If
    Loop
    End With
End Sub

---

I also found a cleaner (to my eyes) solution to the original problem. I.e. replace paragraphs with line breaks inside the selection. It might be useful for someone in the future:

Code:

---

Public Sub Replace5()
    Dim rngCurr As Range
    Dim rngNext As Range
    For i = 1 To Selection.Range.Paragraphs.Count - 1
        Set rngCurr = Selection.Range.Paragraphs(i).Range
        Set rngNext = Selection.Range.Paragraphs(i + 1).Range
        If rngCurr.ListFormat.ListType <> wdListBullet Then
            If rngNext.ListFormat.ListType <> wdListBullet Then
                rngCurr.Characters.Last = Chr(11)
            End If
        End If
    Next i
End Sub

---