Finding/deleting repeated text within Cells of a table

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Marc131 - 28 Feb 2007 14:27 GMT

I am trying to find and delete repeated lines of text within a given cell of
a word table; and then repeat this same process for all cells of the table.
For example, in a given cell of a table, the line of text "XYZ_123" might be
repeated 3 three times. I need to delete the 2nd and 3rd occurrence of the
lines of text.

Reply to this Message

Greg Maxey - 28 Feb 2007 14:55 GMT

Marc,

Something like:
Sub Scratchmacro()
Dim oCell As Cell
Dim oRng As Word.Range
Dim i As Long
For Each oCell In Selection.Tables(1).Range.Cells
Set oRng = oCell.Range
oRng.End = oRng.End - 1
With oRng.Find
.Text = "XYZ_123"
While .Execute
i = i + 1
If i > 1 And oRng.Start < oCell.Range.End Then
oRng.Delete
End If
Wend
i = 0
End With
Next oCell
End Sub

> I am trying to find and delete repeated lines of text within a given cell of
> a word table; and then repeat this same process for all cells of the table.
> For example, in a given cell of a table, the line of text "XYZ_123" might be
> repeated 3 three times. I need to delete the 2nd and 3rd occurrence of the
> lines of text.

Reply to this Message

Greg Maxey - 28 Feb 2007 17:01 GMT

Marc,

Provided XYZ_123 is a complete line in a cell, then this may do a
cleaner, faster job:

Sub Scratchmacro()
Dim oCell As Cell
Dim oRng As Word.Range
Dim i As Long
For Each oCell In Selection.Tables(1).Range.Cells
Set oRng = oCell.Range
With oRng.Find
.Text = "XYZ_123"
Do While .Execute
i = i + 1
If oRng.Start > oCell.Range.End Then Exit Do
oRng.MoveEnd wdCharacter, 1
If i > 1 And oRng.Start < oCell.Range.End Then
If oRng.End = oCell.Range.End Then
oRng.MoveStart wdCharacter, -1
oRng.MoveEnd wdCharacter, -1
End If
oRng.Delete
End If
oRng.Collapse wdCollapseEnd
Loop
i = 0
End With
Next oCell
End Sub

Reply to this Message

Marc131 - 05 Mar 2007 00:39 GMT

I need something a bit more generic because every cell in the table has
different text. I need to delete any repeated (complete) line of text in a
given cell.

> Marc,
>
[quoted text clipped - 32 lines]
> > repeated 3 three times. I need to delete the 2nd and 3rd occurrence of the
> > lines of text.

Reply to this Message

Greg Maxey - 05 Mar 2007 04:01 GMT

Try:

Sub ScratchMacro()
Dim pCell As Word.Cell
Dim oParagraphs As Paragraphs
Dim i As Long
Dim j As Long
Dim oRng As Range
Dim oRng2 As Word.Range

If Selection.Information(wdWithInTable) = True Then
Set pCell = Selection.Tables(1).Cell(1, 1)
Do
Set oRng = pCell.Range
oRng.MoveEnd wdCharacter, -1
Set oParagraphs = pCell.Range.Paragraphs
If oParagraphs.Count > 1 Then
oRng.Select
Selection.Range.Sort SortOrder:=wdSortOrderAscending
End If
For i = 1 To oParagraphs.Count
For j = i + 1 To oParagraphs.Count
If oParagraphs(i).Range.Text = oParagraphs(j).Range.Text Then
oParagraphs(j).Range.Delete
j = j - 1
Else
Exit For
End If
Next
Next
Set oRng = oParagraphs.Last.Range
Set oRng2 = oParagraphs.Last.Previous.Range
oRng.MoveEnd wdCharacter, -1
oRng2.MoveEnd wdCharacter, -1
If oRng.Text = oRng2.Text Then
oParagraphs.Last.Previous.Range.Delete
End If
Set pCell = pCell.Next
Loop Until pCell Is Nothing
Set pCell = Nothing
Set oRng = Nothing
Set oRng1 = Nothing
Set oParagraphs = Nothing
Else
MsgBox "A table has not been selected"
End If
End Sub

Signature

Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

> I need something a bit more generic because every cell in the table
> has different text. I need to delete any repeated (complete) line of
[quoted text clipped - 36 lines]
>>> the line of text "XYZ_123" might be repeated 3 three times. I need
>>> to delete the 2nd and 3rd occurrence of the lines of text.

Reply to this Message

Greg Maxey - 05 Mar 2007 13:10 GMT

I thought about this some more and realized that the user might not
want the cell content sorted. The following seems to work (with very
limited testing).

Sub ScratchMacroII()
Dim pCell As Word.Cell
Dim oParagraphs As Paragraphs
Dim i As Long
Dim j As Long
Dim oRng As Range
Dim oRng2 As Word.Range
If Selection.Information(wdWithInTable) = True Then
Set pCell = Selection.Tables(1).Cell(1, 1)
Do
Set oParagraphs = pCell.Range.Paragraphs
For i = oParagraphs.Count To 2 Step -1
For j = oParagraphs.Count - 1 To 1 Step -1
Set oRng = oParagraphs(i).Range
Set oRng2 = oParagraphs(j).Range
oRng.MoveEnd wdCharacter, -1
oRng2.MoveEnd wdCharacter, -1
If oRng.Text = oRng2.Text Then
oParagraphs(j).Range.Delete
i = i - 1
j = j - 1
End If
Next j
Next i
Set pCell = pCell.Next
Loop Until pCell Is Nothing
Set pCell = Nothing
Set oRng = Nothing
Set oRng2 = Nothing
Set oParagraphs = Nothing
Else
MsgBox "A table has not been selected"
End If
End Sub

> I need something a bit more generic because every cell in the table has
> different text. I need to delete any repeated (complete) line of text in a
[quoted text clipped - 38 lines]
>
> - Show quoted text -

Reply to this Message

Greg Maxey - 05 Mar 2007 14:28 GMT

Marc,

Trash the last two suggestions :-(. I still don't guarantee this is
100% reliable, but it corrects mistakes I found in the last posts:

Sub ScratchMacroII()
Dim pCell As Word.Cell
Dim oParagraphs As Paragraphs
Dim i As Long
Dim j As Long
Dim oRng As Range
Dim oRng2 As Word.Range
If Selection.Information(wdWithInTable) = True Then
Set pCell = Selection.Tables(1).Cell(1, 1)
Do
Set oParagraphs = pCell.Range.Paragraphs
For i = oParagraphs.Count To 2 Step -1
For j = i - 1 To 1 Step -1
Set oRng = oParagraphs(i).Range
Set oRng2 = oParagraphs(j).Range
oRng.MoveEnd wdCharacter, -1
oRng2.MoveEnd wdCharacter, -1
If oRng.Text = oRng2.Text Then
oParagraphs(j).Range.Delete
i = i - 1
End If
Next j
Next i
Set pCell = pCell.Next
Loop Until pCell Is Nothing
Set pCell = Nothing
Set oRng = Nothing
Set oRng2 = Nothing
Set oParagraphs = Nothing
Else
MsgBox "A table has not been selected"
End If
End Sub

Reply to this Message

Marc131 - 06 Mar 2007 21:41 GMT

Greg,
Thanks. This appears to do the trick!
Marc

> Marc,
>
[quoted text clipped - 77 lines]
> >
> > - Show quoted text -

Reply to this Message