You've had great responses so far. I use the Scripting
Dictionary most of the time. A dictionary is basically a
collection and works similarly to a collection. However,
there are some very good methods available - for example
the Rxists method allows you to test if a key exists...
If NOT MyDic.Exists(ThisKey) then
MyDic.Add Item, ThisKey
End If

One can loop through both the items AND the Keys which is
really useful.

As an alternative, I also use disconnected recordsets.
These are powerful tools to use in code, as they allow
sorting, filetering etc of data exactly as if one had
used a SQL statement.

In the following example, I have a column of data in a
sheet starting in the third row of column "D". I've
created a recordset to extract the unique items, and used
the recordset's Sort method to drop the list of uique
data into the sheet.

Sub GetValues()
Dim rw As Long ' loop index
Dim sText As String ' cell value
Dim rst As New ADODB.Recordset

' create & open the recordset
With rst
.Fields.Append "KeyName", adChar, 20
.Open
End With

'initialise the row index
rw = 3

'loop for each cell in the column
Do Until Cells(rw, "D") = ""
' get the cell's value
sText = Cells(rw, "D").Value
' check if we already have it in the recordset
If Not rst.BOF Then rst.MoveFirst
rst.Find "[KeyName]='" & sText & "'" ', _
, adSearchForward, True
If rst.EOF Then
' no, then add it
rst.AddNew 0, sText
End If

' increent index for then next cell
rw = rw + 1
Loop

' now sort the recordset
rst.Sort = "KeyName ASC"
'rst.MoveFirst
Range("A1").CopyFromRecordset rst

rst.Close

Set rst = Nothing

End Sub

The project requires a reference to the Active Data
Objects 2.7 Library

HTH
Patrick Molloy
Microsoft excel MVP




-----Original Message-----
I'm looking to take unique values from a defined range
into a form. The values will be alphabetic characters.
Here is what I have so far:

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End
(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value
End If
Next Cell
On Error GoTo 0
End With
Next

MsgBox EnquiryList

End Sub

Why is it that when the code loops into the 2nd sheet,
any
unique values in that sheet's DataRange are not added to
the
Collection, please?

Regards.





---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system
(http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date:
19/08/2003


.