Can you help me to improve this macro?

Tech-Archive recommends: Fix windows errors by optimizing your registry

I would like some help to improve the following macro (I am NOT an Excel
programmer). The macro simply invert a *** where column 1 is for terms and
columns 2-n are for translations. I would like

1. to move the temporary range to another ***, to avoid overlap between
temporary range and current one
2. improve performances

Any hints appreciated. Thank you in advance.

--
Dario de Judicibus - Rome, Italy (EU)
Site: http://www.dejudicibus.it
Blog: http://lindipendente.splinder.com

MACRO
Public Sub ReverseDictionary()
Set tr = Active***.UsedRange
Debug.Print tr.Rows.Count
Debug.Print tr.Columns.Count
Set newlist = Cells(1, tr.Columns.Count + 2) 'Temporary range
newrow = 0
For n = 1 To tr.Rows.Count
head = tr.Cells(n, 1)
c = 2
While Not IsEmpty(tr.Cells(n, c))
newrow = newrow + 1
newlist.Cells(newrow, 1).NumberFormat = "@"
newlist.Cells(newrow, 2).NumberFormat = "@"
newlist.Cells(newrow, 1) = head
newlist.Cells(newrow, 2) = tr.Cells(n, c)
c = c + 1
Wend
Next
Range(newlist, newlist.Cells(newrow, 2)).Sort Key1:=newlist.Cells(1, 2),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
tr.Clear
outrow = 0
head = ""
For n = 1 To newrow
If head = newlist(n, 2) Then
outcol = outcol + 1
tr.Cells(outrow, 1).NumberFormat = "@"
tr.Cells(outrow, outcol).NumberFormat = "@"
tr.Cells(outrow, 1) = head
tr.Cells(outrow, outcol) = newlist(n, 1)
Else
outcol = 1
outrow = outrow + 1
head = newlist(n, 2)
n = n - 1
End If
Next
Range(newlist, newlist.Cells(newrow, 2)).Clear

End Sub


.

Quantcast