Microsoft Office Tutorials and References
In Depth Information
GET AN ARRAY OF UNIQUE VALUES FROM A LIST
Key values. Error trapping during the execution of the For...Next loop is
disabled, using On Error Resume Next , so whenever the code encounters
a duplicate value (which, if already present in the collection, cannot be added
to it), it simply skips to the next cell, without screeching to a halt with an error
message.
When all the items are added to the collection, the code creates an array
UniqArray of the same size as the collection UniqColl.Count and adds
each item of the collection to this array. The array is needed to transfer the
contents to the spreadsheet. Notice the use of the Transpose function
when transferring the array to a column in the sheet; this is needed because
UniqArray is a horizontal array.
Before transferring the unique list to the worksheet or control, it may be desirable
to sort the data alphabetically. To do this, simply insert the following code after
the comment ‘ Optional sort routine can be inserted here:
For i = 1 To UniqColl.Count - 1
For j = i + 1 To UniqColl.Count
If UniqColl(i) > UniqColl(j) Then
Temp1 = UniqColl(i)
Temp2 = UniqColl(j)
UniqColl.Add Temp1, before:=j
UniqColl.Add Temp2, before:=i
UniqColl.Remove i + 1
UniqColl.Remove j + 1
End If
Next j
Next i
The Dictionary Object Approach
The code for the Dictionary object approach is:
Private Sub GetUnique_Dictionary() ‘Using the Dictionary object
Dim UniqueDic As Object
Dim cell As Range
Set UniqueDic = CreateObject("Scripting.Dictionary")
For Each cell In Range("A2:A30")
If Not UniqueDic.Exists(cell.Value) Then
UniqueDic.Add cell.Value, cell.Value
End If
 
Search JabSto ::




Custom Search