Adding text to end of paragraph

[Gem_man]

I know I have made a few posts recently, but it is not for the lack of trying
to sort it out myself. I am stuck!! Any help would be appreciated.

I have a doc with two words in each paragraph and wish add to each paragraph
the number of occassions that this paragraph is duplicated in the doc, then
delete the duplicates.

ie: List before code
Madrid, Spain
London, England
London, England
London, England
Paris, France
Paris, France

Desired result after code:
London, England (3)
Madrid, Spain (1)
Paris, France (2)

Below is the code I have so far (with the help of Doug and Jay)

I am working on the theory that the number of deleted duplicates (x
variable) represents the number of times that paragraph is duplicated

Can anyone suggest soemthing that might work. I dont think I could stand
another two nights of 3am bedtimes!

Dim i As Long
With Target
.Content.Sort SortOrder:=wdSortOrderAscending
For i = .Paragraphs.Count To 2 Step -1
If .Paragraphs(i).Range.Text = _
.Paragraphs(i - 1).Range.Text Then
.Paragraphs(i).Range.Delete : x = x+1 'number of deletes
equals the numbers of matches
End If
Next i
Do While Len(.Paragraphs(1).Range.Text) = 1
.Paragraphs(1).Range.Delete
Loop
.Activate

End With

 

[Helmut Weber]

Hi,

BTW, a real name would be much nicer,

have a look at this one:

No sorting required:

Sub Macro5()
Dim oPrg1 As Paragraph
Dim oPrg2 As Paragraph
Dim rTmp As Range
Dim l As Long

For Each oPrg1 In ActiveDocument.Paragraphs
l = 0
For Each oPrg2 In ActiveDocument.Paragraphs
If oPrg1.Range.Text = oPrg2.Range.Text Then
l = l + 1
If l > 1 Then
oPrg2.Range.Delete
End If
End If
Next
Set rTmp = oPrg1.Range
rTmp.End = rTmp.End - 1
rTmp.InsertAfter " (" & CStr(l) & ")"
Next

End Sub

However, for a large amount of data, previous sorting
would be recommended, but would result in another algorithm.

I'd delete empty paragraphs beforehand:

For Each oPrg1 In ActiveDocument.Paragraphs
If Len(oPrg1.Range) = 1 Then oPrg1.Range.Delete
Next

Ask again, if you need a routine for previously sorted data.

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Gem_man]

Quite spectacular. Many many thanks Helmut. This works an absolute treat.

Geeeze, if you knew how long I had been trying to get it right!!

Regards
Adrian