Excel VBA 2010 - how to create a single dimension with unique values array from table column

I have a workbook that has a defined table on a sheet.  I want to get the unique values from one of the columns in the table and put those unique values in an array so I can loop over them.  A blank value should count as a unique value.   How can this be accomplished? My table name is T_201311 and the column name is EnterpriseID.
mamusciaAsked:
Who is Participating?
 
byundtConnect With a Mentor Commented:
Here is a sub & function using the Scripting Dictionary collection to make a list of the unique values in your table. The function returns the unique items in an array.

Note that I set a reference to "Microsoft Scripting Runtime" by checking its box in the Tools...Reference menu item.
Function Uniques(sTableName As String, sColumnName As String) As Variant
Dim dic As Scripting.Dictionary
Dim i As Long, n As Long
Dim v As Variant, vData As Variant, vResults As Variant
Dim tbl As ListObject
Dim col As ListColumn
Set dic = CreateObject("Scripting.Dictionary")
With ActiveSheet
    Set tbl = .ListObjects(sTableName)
    Set col = tbl.ListColumns(sColumnName)
    vData = col.DataBodyRange.Value
End With
On Error Resume Next
For Each v In vData
    dic.Add v, v
Next
On Error GoTo 0
    n = dic.Count
ReDim vResults(1 To n)
For i = 1 To n
    vResults(i) = dic.Items(i - 1)
Next
Uniques = vResults
End Function

Sub Test()
Dim v As Variant
v = Uniques("T_201311", "EnterpriseID")
Range("Q1").Resize(UBound(v)).Value = Application.Transpose(v)
End Sub

Open in new window

0
 
byundtCommented:
The easiest way to get a list of unique values is using Advanced Filter on that column and writing the unique results to a worksheet range. Here is a code snippet that uses that method to put the unique values in an empty column to the right of the used range. As written, it hides that column and creates a named range that points to the list of unique items (excluding header).
    Set rg = .UsedRange
    Set rg = rg.Cells(1, 1).Offset(0, rg.Columns.Count + 1)
    .Range("A6").CurrentRegion.Columns(1).AdvancedFilter xlFilterCopy, , CopyToRange:=rg, Unique:=True
    Set rg = rg.CurrentRegion
    Set rg = rg.Offset(1, 0).Resize(rg.Rows.Count - 1)
    rg.EntireColumn.Hidden = True

Open in new window


Another way to do it is to create a dictionary object, which doesn't tolerate duplicates.
0
 
mamusciaAuthor Commented:
thanks. this works and gives me the array I wanted.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.