Extracting unique entries and assigning it to a named range

[Hari]

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

 

[Guest]

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")

 

[keepITcool]

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 :

 

[Hari]

Patrick and keepITcool,

Thanks for a detailed solution using dictionary method.

Im sorry, actually I need to send this across to somebody else and
prefer not instructing the other person to add references to in their
VB (the person wouldnt like to get in to VB environment). Hence, a
formula based solution (or if not possible then a code which would
return an array without setting of references) would be preferable.
(Can the formula based soltuion be made dynamic using a variant of
indirect formula, so that if list changes from A1:A1000 then also it
works.)

(actually am planing to use this unique list in a validation box.)

Regards,
Hari
India

PS: I should have posted it to Misc group rather than programming group.