Hi Ivanov,

Very good to hear and thanks for the feedback. Us Ivan's have to stick
together :)

Cheers,

On Apr 2, 1:47*am, "
wrote:
Hi Ivyleaf,

Now the macro works like charm! Thank you very much for your help.

You rule!

And here is the final macro for someone else who may need it:

Sub MergeList()
* * Dim FrList As Range, DeList As Range, DestList As Range
* * Dim cell As Range, WordList As New Collection, i As Integer

'This sets the range of the French list
* * Set FrList = Sheets("French").Range("A1")
* * Set FrList = Range(FrList, FrList.Range("A65536").End(xlUp))
* * FrList.Resize(FrList.Rows.Count, 2).Name = "FrList"

'This sets the range of the German list
* * Set DeList = Sheets("German").Range("A1")
* * Set DeList = Range(DeList, DeList.Range("A65536").End(xlUp))
* * DeList.Resize(DeList.Rows.Count, 2).Name = "DeList"

'This sets the range of the new destination list
* * Set DestList = Sheets("Merged").Range("A1")

'Turn off screen refresh & calculation to speed up execution
* * Application.ScreenUpdating = False
* * Application.Calculation = xlCalculationManual

'Error handling for when the program attempts to add
'the same word to the collection twice
* * On Error Resume Next

'Add English words from French list
* * * * For Each cell In FrList.Cells
* * * * * * If Not IsEmpty(cell) Then
* * * * * * WordList.Add cell.Value, CStr(cell.Value)
* * * * * * End If
* * * * Next

'Add English words from German list (ignoring duplicates)
* * * * For Each cell In DeList.Cells
* * * * * * If Not IsEmpty(cell) Then
* * * * * * WordList.Add cell.Value, CStr(cell.Value)
* * * * * * End If
* * * * Next

'Turn error notification back on
* * On Error GoTo 0

'Resize destination list to fit total words
* * Set DestList = DestList.Resize(WordList.Count, 1)

'Loop to put words to new list
* * i = 1
* * For Each Item In WordList
* * * * DestList.Cells(i) = Item
* * * * i = i + 1
* * Next

'Sort new list alphabetically
* * DestList.Sort DestList, xlAscending

'Perform code based VLookup for French and German
* * On Error Resume Next
* * For Each cell In DestList.Cells
* * * * FrList.Cells(Application.Match(cell.Value, FrList,
0)).Offset(0, 1).Copy
* * * * If Err.Number = 0 Then Sheets("Merged").Paste
Destination:=cell.Offset(0, 1)
* * * * Err.Clear
* * * * DeList.Cells(Application.Match(cell.Value, DeList,
0)).Offset(0, 1).Copy
* * * * If Err.Number = 0 Then Sheets("Merged").Paste
Destination:=cell.Offset(0, 2)
* * * * Err.Clear
* * Next

'Clean up
* * With Sheets("Merged")
* * * * .Rows("1:1").Insert Shift:=xlDown
* * * * .Range("A1:C1") = Array("English", "French", "German")
* * * * .Columns.AutoFit
* * * * .Rows.AutoFit
* * * * .Cells.VerticalAlignment = xlTop
* * End With
* * Application.ScreenUpdating = True
* * Application.Calculation = xlCalculationAutomatic

End Sub