Duplicates problem

[ejlowe]

Hello. I was just referred to the board and already have a question.

I have a document which contains 40 pages. It was exported from a Lexis tool.

Here is an example of the format:

1. HAND ARENDALL, L.L.C., Suite 900 Park Place Tower 2001 Park Place North Birmingham, Alabama 35203, (Jefferson County), Telephone: 205-324-4400, Telecopier: 205-322-1163, Email: firmcontact@handarendall.com, Web-Site: http://www.handarendall.com, United States, Professional Biographies Section, Copyright 2001 by Reed Elsevier Inc., Martindale-Hubbell
... Minolta-QMS, Inc.; Shell Chemical Company. Communications: ...

2. MAYNARD, COOPER & GALE, P.C., 2400 AmSouth/Harbert Plaza 1901 Sixth Avenue North Birmingham, Alabama 35203-2618, (Jefferson County), Telephone: 205-254-1000, Facsimile: 205-254-1999, Email: macoga@mcglaw.com, Web-Site: http://www.mcglaw.com, (MAIN OFFICE), United States, Professional Biographies Section, Copyright 2001 by Reed Elsevier Inc., Martindale-Hubbell
... America; Exxon Corp.; Shell Oil Co.; Phillips ...

3. MCDANIEL, BAINS & NORRIS, P.C., Two Metroplex Drive - Suite 504 Birmingham, Alabama 35209, (Jefferson County), Telephone: 205-871-1811, Facsimile: 205-871-4511, Email: lawinfo@mbn-law.com, Web-Site: http://www.mbn-law.com, (MAIN OFFICE), United States, Professional Biographies Section, Copyright 2001 by Reed Elsevier Inc., Martindale-Hubbell
... Shelby Insurance Group; Shell Oil Company; Southern ...

4. WILLIAMS, POTTHOFF, WILLIAMS & SMITH, L.L.C., 125 South Orange Avenue Eufaula, Alabama 36027-1626, (Barbour County), Telephone: 334-687-5834, Fax: 334-687-5722, Web-Site: http://www.lawyers.com/wpws, (MAIN OFFICE), United States, Professional Biographies Section, Copyright 2001 by Reed Elsevier Inc., Martindale-Hubbell
... Reynolds; Royal Globe; Shell Oil; State Farm; ...

5. HAND ARENDALL, L.L.C., 112 West Laurel Avenue Foley, Alabama 36535, (Baldwin County), Telephone: 251-970-5511, Fax: 251-970-3375, Email: firmcontact@handarendall.com, Web-Site: http://www.handarendall.com, United States, Professional Biographies Section, Copyright 2001 by Reed Elsevier Inc., Martindale-Hubbell
... Minolta-QMS, Inc.; Shell Chemical Company. Communications: ...

6. ATCHISON, CROSBY, SAAD & BEEBE, P.C., 3030 Knollwood Drive Mobile, Alabama 36693, (Mobile County), Telephone: 251-665-7200, Fax: 251-665-7250 URL: http://www.acsblaw.com, Web-Site: http://www.lawyers.com/acsblaw, (MAIN OFFICE), United States, Professional Biographies Section, Copyright 2001 by Reed Elsevier Inc., Martindale-Hubbell
... Catastrophe Services, Inc.; Shell Oil Company; Owens- ...

7. HAND ARENDALL, L.L.C., 3000 AmSouth Bank Building 107 St. Francis Street P.O. Box 123 Mobile, Alabama 36602, (Mobile County), Telephone: 251-432-5511, Fax: 251-694-6375, Email: firmcontact@handarendall.com, Web-Site: http://www.handarendall.com, (MAIN OFFICE), United States, Professional Biographies Section, Copyright 2001 by Reed Elsevier Inc., Martindale-Hubbell
... Minolta-QMS, Inc.; Shell Chemical Company. Communications: ...


I am needing to find a way to delete all of the duplicate firms throughout the document, such as numbers 5 & 7. Can anyone tell me how I can do this?

Thank you for your help.<b></b><b></b><b></b><b></b>

[Anne Troy]

I am thinking this, but of course there may be much fancier VBA solutions.

Select all of your text and not one paragraph marker more than the last one behind the last item.

Hit Table-Convert text to table. Tell it how many columns, and use commas as delimiters.

If that appears to work, copy/paste into Excel and sort by column 1. After deleting duplicates, you can copy/paste back into Word and back into text.

Might be just as easy to do it manually. Depends on how the data is laid out.

~Dreamboat
TheWordExpert

[smozgur]

How about a macro way? :)
This code should work for you.

Open VBA Editor and paste this sub in thisdocument module then press F5 to run it and see your duplicated firms will be erased. But i am not sure about one thing, addresses are different for same firms !?

Anyway, here is the code


Sub DeleteDuplicates()
Dim i As Integer, j As Integer
Dim k As Integer
Dim tmpStrMain As String
Dim tmpStrCr As String

With ThisDocument
k = .Paragraphs.Count
For i = 1 To k
tmpStrMain = .Paragraphs(i).Range.Text
For j = i + 1 To k
tmpStrCr = .Paragraphs(j).Range.Text
If Not Asc(tmpStrCr) = 13 Then
If Not InStr(1, tmpStrMain, . ) = 0 Then
If Mid(tmpStrMain, InStr(1, tmpStrMain, . ) + 2, InStr(1, tmpStrMain, , ) - InStr(1, tmpStrMain, . ) - 2) = Mid(tmpStrCr, InStr(1, tmpStrCr, . ) + 2, InStr(1, tmpStrCr, , ) - InStr(1, tmpStrCr, . ) - 2) Then
ThisDocument.Paragraphs(j).Range.Delete
k = k - 1
End If
End If
End If
If k <= j Then Exit For
Next j
If k <= i Then Exit For
Next i
End With
End Sub


Regards

Oz

[Anne Troy]

Sweet, Oz!

~Dreamboat
TheWordExpert