Patrick,

I concur in your choice for a Dictionary rather than a Collection.
The obvious (speed) advantage is has arrays for keys and items.
and it has the possibility to make CaseSensitive comparisons.

The arrays can be extracted in 1 command iso collections loop and thus
simply written to a range BUT your code doesn't exploit this advantage..

I've rewritten it as follows (hope you dont mind ;)

Note: transpose has problems on large arrays in older xl versions.
Note: transpose has no problems with the 0based arrays.
Note: testing .Exists() is slower than ignoring errors
Note: testing for empties is slower than removing the nullstring key at
the end.

Option Explicit

Sub GetList()
Dim dic As Scripting.Dictionary
Dim rngSrc As Range
Dim rngDst As Range
Dim rngCel As Range

Set dic = New Scripting.Dictionary
dic.CompareMode = TextCompare 'CaseInsensitive

Set rngSrc = Range("a1:a1000")
On Error Resume Next
For Each rngCel In rngSrc.Cells
With rngCel
dic.Add Trim(.Value), .Value
End With
Next
dic.Remove vbNullString
On Error GoTo 0

Set rngDst = SetRange("myoutput")
With rngDst
.Resize(rngSrc.Rows.Count).Clear

With .Resize(dic.Count, 1)
.Name = "myoutput"
.Value = Application.Transpose(dic.Items)
.Sort .Columns(1), xlAscending
End With
End With

End Sub

Private Function SetRange(sRngName As String) As Range
On Error Resume Next
Set SetRange = Range(sRngName)
If SetRange Is Nothing Then
Set SetRange = Worksheets.Add().Range("A1")
setrange.name = sRngName
End If
End Function

--






--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Patrick Molloy wrote :

we can use a collection, in this case a dictionary, to collect the
unique values. A dictionary allows you to test for whether an entry
exists. Its not fast, but fro a few thousand records, its efficient.

First, in the IDE set a refrenece ( menu: Tools/References) to the
Microsoft Scripting Runtime DLL, this is where the dictionary object
is defined.


Option Explicit
Sub GetList()
Dim key As String
Dim target As Range
Dim Source As Range
Dim dic As Scripting.Dictionary
Dim cell As Range
Dim index As Long

Set dic = New Scripting.Dictionary
Set Source = Range("A1:A1000")
For Each cell In Source.Cells

key = Trim(cell.Value)
If key < "" Then
If Not dic.Exists(key) Then
dic.Add key, key
End If

End If

Next

Set target = SetRange("myoutput")
If target Is Nothing Then
Dim ws As Worksheet
Set ws = Worksheets.Add
Set target = ws.Range("A1")
Else
target.Clear
End If

With target.Resize(dic.Count)
For index = 1 To dic.Count
target.Cells(index, 1) = dic.Keys(index - 1)
Next
.Name = "myoutput"
End With

End Sub
Private Function SetRange(rangename As String) As Range
On Error Resume Next
Set SetRange = Range("myoutput")
On Error GoTo 0
End Function


"Hari" wrote:

Hi,

I have come across the formula in Chip's page
http://cpearson.com/excel/duplicat.htm#ExtractingUnique
for extracting unique values. My requirement is to store the list
of all unique entries from a range (let' say A1: A100) in to a Named
range. Is there a formula based solution to the same? (probably
using an appropriate array formula within named range dialog box).

Please guide me for the same.

Regards,
Hari
India