Search and replace within selection

[0tto]

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:

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.

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.

[0tto]

I found a possible solution:

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:

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