Extract Text in braquet and list of terms from 2 Docs

[XRope]

Hi everyone,

I Have a macro to extract text within parentheses from 2 Docs and put them in 2 columns in a new Doc.
My problem is thta I want to add to that a list of countries but to extracted too from both Docs and added to the text in 2 columns, this of course in order of apearance.

I have a list of countries but dont know where to put them in the code.

Here is the code

Sub GetTermsFrom2Docs_AddToNewDoc()

Dim doc_name1 As String: doc_name1 = "C:\User\Desktop\test\Doc1.docx"
Dim doc1 As Document: Set doc1 = Documents.Open(doc_name1)
Dim rng1 As Range: Set rng1 = doc1.Content
Dim arr1(1 To 1000)

Dim doc_name2 As String: doc_name2 = "C:\User\Desktop\test\Doc2.docx"
Dim doc2 As Document: Set doc2 = Documents.Open(doc_name2)
Dim rng2 As Range: Set rng2 = doc2.Content
Dim arr2(1 To 1000)

Dim new_doc_name As String: new_doc_name = "C:\User\Desktop\test\NewDoc.docx"
Dim new_doc As Document: Set new_doc = Documents.Add
Dim new_doc_rng As Range: Set new_doc_rng = new_doc.Content
new_doc.SaveAs2 new_doc_name

Dim x As Integer
x = 1
With rng1.Find
.ClearFormatting
.Forward = True
.Text = "\(*\)"
.MatchWildcards = True
.Execute
Do While .Found
arr1(x) = Mid(rng1.Text, 2, Len(rng1.Text) - 2)
x = x + 1
.Execute
Loop
End With
doc1.Close

x = 1
With rng2.Find
.ClearFormatting
.Forward = True
.Text = "\(*\)"
.MatchWildcards = True
.Execute
Do While .Found
arr2(x) = Mid(rng2.Text, 2, Len(rng2.Text) - 2)
x = x + 1
.Execute
Loop
End With
doc2.Close

Dim tbl As Table
Set tbl = new_doc_rng.Tables.Add(new_doc_rng, 2, 2)

tbl.Cell(1, 1).Range.Text = "Countries from Doc1:"
tbl.Cell(1, 2).Range.Text = "Countries from Doc2:"

Dim countries1_as_string As String
For x = 1 To UBound(arr1)
If arr1(x) <> "" Then
countries1_as_string = _
countries1_as_string & arr1(x) & Chr(10)
End If
Next x
tbl.Cell(2, 1).Range.Text = countries1_as_string

Dim countries2_as_string As String
For x = 1 To UBound(arr1)
If arr1(x) <> "" Then
countries2_as_string = _
countries2_as_string & arr2(x) & Chr(10)
End If
Next x
tbl.Cell(2, 2).Range.Text = countries2_as_string

new_doc.SaveAs2 new_doc_name
End Sub

 

[macropod]

Cross-posted at: http://www.msofficeforums.com/word-vba/39477-extract-list-terms-combine-table.html
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

 

[XRope]

All understood

How do I delete this thread ?

 

[Becky]

All understood

How do I delete this thread ?

No need to delete the thread, but it would be useful if you could share any solution so that others can benefit