To merge two document

[Pasquale]

Hallo I need help to merge two very long docs.
I have two english dictionary that had the headword in bold character and its meaning in normal (not bold) character.

All headwords (in every dictionary) are arranged in the order of the letters of the alphabet.


How can I merge the two document in a document with headwords and its meaning arranged in the order of the letters of the alphabet.:think:?'

Thanks Pasquale

[mdmackillop]

Can you post a small sample of both files?

[Pasquale]

thanks

pasquale

[mdmackillop]

Hi Pasquale,
A bit cludgy, with some apparent errors, but see how it goes.
Other methods to consider,
1. Create Autotexts from each MyRange and compile these.
2. Join both documents, create Bookmarks from each MyRange and sort these.

Create a folder "C:\Alpha"
Run this code on first and second. It should copy each heading with text into a new document named after the heading.

Option Explicit
Sub alpha()
Dim aWord, pos As Long, pos2 As Long, MyRange
pos = 1
For Each aWord In ActiveDocument.Words
If aWord.Font.Bold = True Then
aWord.Select
pos2 = Selection.Range.Start
Set MyRange = ActiveDocument.Range(Start:=pos - 1, End:=pos2 - 1)
If Len(MyRange) > 1 Then
MyRange.Select
MyRange.Copy
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
Selection.PasteAndFormat (wdPasteDefault)
ActiveDocument.SaveAs FileName:="C:\Alpha\" & aWord & ".doc", _
FileFormat:=wdFormatDocument
ActiveDocument.Close
End If
pos = pos2 + 1
End If
Next
End Sub


Open a new document and run this code. It should create an array of document names, sort aplabetically, then import them in order.


Option Explicit

Sub Compile()
Dim MyArr, fs, cnt As Long, i As Long, MyFile As String
Set fs = Application.FileSearch
With fs
.LookIn = "C:\Alpha"
.FileName = "*.doc*"
.Execute
cnt = .FoundFiles.Count - 1
End With
ReDim MyArr(cnt)
MyFile = Dir("C:\Alpha\*.doc")
Do Until MyFile = ""
MyArr(i) = MyFile
i = i + 1
MyFile = Dir
Loop
Quick_Sort MyArr, 0, UBound(MyArr)
For i = 0 To cnt
Selection.InsertFile FileName:=MyArr(i)
Next
End Sub


Private Sub Quick_Sort(ByRef SortArray As Variant, ByVal First As Long, ByVal Last As Long)
Dim Low As Long, High As Long
Dim Temp As Variant, List_Separator As Variant
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub

[Pasquale]

Thanks to mdmackillop,
It was easier Select all in one document and copy, open the other document, and paste.

The macro not works. When a bold word is the same the macro overwrite the words.

Thanks very much for help

pasquale

[fumei]

I don't understand the sample documents.

First.doc has text under AARON. Starts with:

"AARON the eldest son of Amram and Jochebed, a daughter of "

Second.doc also has text for Aaron. Starts with:

"Aaron (according to Jerome means "mountain of strength"), the oldest son of Amram and Jochebed, "

They are different.

What are you trying to do??? Are you trying to merge the different text for each heading? If that is so, are you trying append them? So, for example, the heading for Aaron would have TWO different starts, as in the text above???

[Pasquale]

What are you trying to do??? Are you trying to merge the different text for each heading?
Yes



If that is so, are you trying append them? So, for example, the heading for Aaron would have TWO different starts, as in the text above???
I would append the second after the first without to change the txt.


Thanks pasquale