View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Patrick Molloy[_2_] Patrick Molloy[_2_] is offline
external usenet poster
 
Posts: 1,298
Default Extracting unique entries and assigning it to a named range

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