Using VBA to Read AutoFilter Criteria - vba

Question

I am working with an excel workbook where I want to find all unique values in a column.
I have code that works by looping through all the rows and for each row looping through a collection of values seen so far and checking if I've seen it before.
It works like this.
Function getUnique(Optional col As Integer) As Collection
If col = 0 Then col = 2
Dim values As Collection
Dim value As Variant
Dim i As Integer
Dim toAdd As Boolean
i = 3 'first row with data
Set values = New Collection
Do While Cells(i, col) <> ""
toAdd = True
For Each value In values
If Cells(i, col).value = value Then toAdd = False
Next value
If toAdd Then values.Add (Cells(i, col).value)
i = i + 1
Loop
Set getUnique = values
End Function
However, Excel AutoFilter is able to find these values much faster. Is there a way to filter and then read the unique values?
I've tried using the AutoFilter.Filters object but all of the .ItemX.Criteria1 values have a "Application-defined or object-defined error" (found using a watch on ActiveSheet.AutoFilter.Filters).

Answer 1

This isn't quite doing what you describe, I think it's processing it less-efficiently because it's checking every cell against every value.
I think this is probably inefficient, because as the values collection grows in length, the second loop will take longer to process.
You could get some improvement if you exit your nested For early:
Do While Cells(i, col) <> ""
For Each value In values
If Cells(i, col).value = value Then
toAdd = False
Else:
values.Add (Cells(i, col).value)
Exit For '### If the value is found, there's no use in checking the rest of the values!
End If
Next value
i = i + 1
Loop
But I think a Dictionary may give you performance improvement. This way, we don't need to loop over the collection, we just make use of the dictionary's .Exists method. If it doesn't exist, we add to the collection, if it does, we don't. Then the function still returns the collection of uniques.
Function getUnique(Optional col As Integer) As Collection
If col = 0 Then col = 2
Dim values As Object
Dim value As Variant
Dim i As Integer
Dim toAdd As Boolean
Dim ret as New Collection
i = 3 'first row with data
Set values = CreateObject("Scripting.Dictionary")
With Cells(i, col)
Do While .Value <> ""
If Not values.Exists(.Value)
values(.Value) = 1
ret.Add(.Value) '## Add the item to your collection
Else
'## Count the occurences, in case you need to use this later
values(.Value) = values(.Value) + 1
End If
i = i + 1
Loop
Set getUnique = ret
End Function

Answer 2

The AdvancedFilter method may come in handy here and produce cleaner, easier to maintain code. This will work so long as you are calling this Function from another VBA module and not from a cell.
Function getUnique(Optional col As Integer) As Collection
If col = 0 Then col = 2
Dim values As Collection
Dim value As Variant
Dim i As Integer
i = 3 'first row with data
Range(Cells(i, col), Cells(Rows.Count, col).End(xlUp)).AdvancedFilter xlFilterCopy, CopyToRange:=Cells(1, Columns.Count)
Set values = New Collection
Dim cel As Range
For Each cel In Range(Cells(1, Columns.Count), Cells(1, Columns.Count).End(xlDown))
values.Add cel.value
Next
Range(Cells(2, Columns.Count), Cells(1, Columns.Count).End(xlDown)).Clear
Set getUnique = values
End Function
Tested with this sub:
Sub Test()
Dim c As Collection
Set c = getUnique(4)
For i = 1 To c.Count
Debug.Print c.Item(i)
Next
End Sub