Dario,

It's a tricky little devil - I did clean it up a little
and the reversed list goes on a new sheet.
It ought to be closer to what you want.
'--------------------------------------------------
Option Explicit

Public Sub ReverseDictionary()
'Modified by Jim Cone - San Francisco, USA on June 14, 2005
'to add a new worksheet to contain the reversed dictionary.
On Error GoTo ErrHandler
Dim rngOriginal As Excel.Range
Dim rngTop As Excel.Range
Dim wsNew As Excel.Worksheet
Dim NewRow As Long
Dim OutRow As Long
Dim OutCol As Long
Dim n As Long
Dim c As Long
Dim Head As Variant

Set rngOriginal = ActiveSheet.UsedRange
'Debug.Print rngOriginal.Rows.Count
'Debug.Print rngOriginal.Columns.Count
Set wsNew = Worksheets.Add(befo=ActiveSheet, Count:=1)
On Error Resume Next
wsNew.Name = "Reversed " & Format$(Date, "ddmmyy")
On Error GoTo ErrHandler
Set rngTop = wsNew.Cells(1, rngOriginal.Columns.Count + 2)
Application.ScreenUpdating = False

For n = 1 To rngOriginal.Rows.Count
Head = rngOriginal(n, 1).Value
c = 2
While Not IsEmpty(rngOriginal(n, c))
NewRow = NewRow + 1
rngTop(NewRow, 1).NumberFormat = "@"
rngTop(NewRow, 2).NumberFormat = "@"
rngTop(NewRow, 1) = Head
rngTop(NewRow, 2).Value = rngOriginal(n, c).Value
c = c + 1
Wend
Next

Range(rngTop, rngTop(NewRow, 2)).Sort Key1:=rngTop(1, 2), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
OutRow = 0
Head = ""

For n = 1 To NewRow
If Head = rngTop(n, 2) Then
OutCol = OutCol + 1
wsNew.Range(rngOriginal.Address)(OutRow, 1).NumberFormat = "@"
wsNew.Range(rngOriginal.Address)(OutRow, OutCol).NumberFormat = "@"
wsNew.Range(rngOriginal.Address)(OutRow, 1) = Head
wsNew.Range(rngOriginal.Address)(OutRow, OutCol) = rngTop(n, 1)
Else
OutCol = 1
OutRow = OutRow + 1
Head = rngTop(n, 2)
n = n - 1
End If
Next
Range(rngTop, rngTop(NewRow, 2)).ClearContents
ExitProcess:

Application.ScreenUpdating = True
Set rngOriginal = Nothing
Set rngTop = Nothing
Set wsNew = Nothing
Exit Sub

ErrHandler:
Beep
Resume ExitProcess
End Sub
'----------------------------


----- Original Message -----
From: "Dario de Judicibus"
Newsgroups: microsoft.public.excel.programming
Sent: Tuesday, June 14, 2005 5:11 AM
Subject: Can you help me to improve this macro?


Jim Cone wrote:
Dario,
The following ought to be close to what you want
and it certainly is simpler. Does it do what you wanted?
'--------------------------------
Sub ReverseDirectory_New()
Application.ScreenUpdating = False
Columns("D:E").Insert shift:=xlShiftToRight
Columns("D:E").Value = Columns("A:B").Value
Columns("A").Value = Columns("E").Value
Columns("B").Value = Columns("D").Value
Application.ScreenUpdating = True
End Sub
'--------------------------------------

Apart screen updating (good idea to disable it - I did not know it was
possible), I am not sure that your code does what I need. Let me clarify:
I have a sheet where column A contains terms. Columns B to <any may contain
one or more translations. For example

| home | casa | abitazione | focolare |
| house | casa | costruzione |
| building | edificio | costruzione |

now, I need to reverse dictionary

| abitazione | home |
| casa | home | house |
| costruzione | house | building |
| edificio | building |
| focolare | home |

note that every record has different length in terms of columns. The macro I
published (made by a kind excel programmer) is good, but too slow for big
dictionaries and furthermore it uses the SAME worksheet for temporary stuff
(it works in two steps). Is it possible to use a temporary sheet and improve
performances?
Thank you in advance.
Dario de Judicibus