Hi Ivyleaf,

Thank you for your helpfulness! I appreciate it.

I tested your last macro. However, the code doesn't process the German
wordlist. The macro copies some French words in the German column of
the Merged worksheet


On Apr 1, 12:27*pm, Ivyleaf wrote:
Hope I'm not double posting here... my last one didn't seem to work.
Anyway, give this code a try... I reckon it will do the trick:

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
* * * * FrList.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

On Apr 1, 9:03*pm, Ivyleaf wrote:



Hmmm,

Just downloaded your book to have a look. I didn't realise the
translation cells had special formatting. This means that the VLookup
formula won't work (well it will, but the result will not be
formatted). This will require two further loops as I see it,
performing the vlookup manually be code.

I'll give it a go.

Other than that, my code seems to do what you want. All I had to do
was change the names of the sheets right at the start.

Cheers,
Ivan.

On Apr 1, 8:58*pm, Ivyleaf wrote:

Hi Ivanov,

This code should do it. I used a collection to compile the list of
unique words as i didn't know how long your list would be. A quicker
method would be to copy one list below the other and use advanced
filter to extract the unique records, but that has a limitation of the
two lists together being no longer than 64K rows in total (in Excel
2003). The collection method negates this.

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("Sheet1").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("Sheet2").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("Sheet3").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

'Add VLookup formulas for French and German
* * DestList.Offset(0, 1).FormulaR1C1 =
"=IF(ISERROR(VLOOKUP(RC[-1],FrList,2,0)),"""",VLOOKUP(RC[-1],FrList,
2,0))"
* * DestList.Offset(0, 2).FormulaR1C1 =
"=IF(ISERROR(VLOOKUP(RC[-2],DeList,2,0)),"""",VLOOKUP(RC[-2],DeList,
2,0))"

'Clean up
* * Application.ScreenUpdating = True
* * Application.Calculation = xlCalculationAutomatic

End Sub

*** Beware of wrapping.

Let me know how you go.

Cheers,
Ivan C.

On Apr 1, 8:21*pm, "
wrote:

Here is a sample of the file to process:http://rapidshare.com/files/10399603...ists.xlsx.html

Thank you for any help suggested- Hide quoted text -

- Show quoted text -- Hide quoted text -

- Show quoted text -- Hide quoted text -

- Show quoted text -