Macro to create a list of unique value in a given order

[diepvic]

Hi,

I need to write a macro which lists down only unique value from a data table
and then, it sort the list in a given order .

My case is: I need a list of currencies from a database. Then, sort them in
the following order: USD, EUR, VND, other currencies in alphabetical order.

Anybody has an idea?

Thanks so much

 

[Joel]

Use advance filter and sort like below.

With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

.Range("A1:A" & LastRow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Sheets("Sheet2").Range("C1"), _
Unique:=True
End With

With Sheets("Sheet1")

LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:A" & LastRow).Sort _
key1:=.Range("A1"), _
order1:=xlAscending, _
header:=xlNo

End With

 

[Joel]

Andvance filter doesn't work across two worksheets. try this instead

With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

.Range("A1:A" & LastRow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("C1"), _
Unique:=True

LastRow = .Range("C" & Rows.Count).End(xlUp).Row
.Range("C1:C" & LastRow).Sort _
key1:=.Range("C1"), _
order1:=xlAscending, _
header:=xlNo

End With

 

[diepvic]

Thx Joel for your reply.

Your code helps me to get a list of unique values and sort it in an
alphabetical order.
However, the requirement is to arrange them with USD in the 1st place, then
EUR, VND and other currencies. With other currencies, I can use the
alphabetical order to sort them.
E.g: my list can be: USD, EUR, VND, CHF, DKK, GBP,

 

[Joel]

Do you ned to create the list more than once? Just move the 3 you need at
the beginning and the others will be in alphabetical order. If you ned to
autmoted the process the simply find the 3 you need at the beginning and then
cut and paste them where they belong.

With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

.Range("A1:A" & LastRow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("C1"), _
Unique:=True

LastRow = .Range("C" & Rows.Count).End(xlUp).Row
.Range("C1:C" & LastRow).Sort _
key1:=.Range("C1"), _
order1:=xlAscending, _
header:=xlNo

set c=.Range("C" & Rows.Count).find("USA",lookin:=xlvlaues,lookat:=xlwhole)
c.cut
..Range("C1").Insert Shift:=xldown


set c=.Range("C" & Rows.Count).find("EUR",lookin:=xlvlaues,lookat:=xlwhole)
c.cut
..Range("C2").Insert Shift:=xldown

set c=.Range("C" & Rows.Count).find("VND",lookin:=xlvlaues,lookat:=xlwhole)
c.cut
..Range("C3").Insert Shift:=xldown

End With