UDF to List Unique Values Unsorted in a Non-Array Formula

[stu40]

Hi,

I have been using this UDF to get a list of sorted unique values from a field BATCH in a table TRANSACTIONS in a separate sheet -

Function FilterUniqueSort(ByRef rng As Range, ByVal ref As Long)
    Dim e, x
    With CreateObject("System.Collections.ArrayList")
        For Each e In rng.Value
            If e <> "" Then
                If IsNumeric(e) Then e = Format$(e, String(20, "0") & _
                ".000000000")
                If Not .Contains(e) Then .Add e
            End If
        Next
        .Sort
        x = .ToArray
        If .Count >= ref And ref <= .Count Then
            If IsNumeric(x(ref - 1)) Then x(ref - 1) = Val(x(ref - 1))
            FilterUniqueSort = x(ref - 1)
        Else
            FilterUniqueSort = ""
        End If
    End With
End Function

In a separate sheet, I just copy this formula =FilterUniqueSort(Transactions[Batch],ROW(AD1)) down as many rows as necessary, and because it doesn't need an array, I can use the results within a table. It's been working great for the last 10 months, but if there are more than a few thousand records, it can be quite slow.

I want to speed up the processing now by removing the sorting function, and I have tried to edit the code so it no longer sorts, but with no success. If someone could find a way to remove the sorting function from the code, I would be really appreciative. I spent 3 hours yesterday trawling google for alternate code, but with no success.

Thanks in advance for your assistance,
Stuart

 

[stu40]

I received a solution from another forum, so I'm pasting it here -

Function FilterUnique(ByRef rng As Range, ByVal ref As Long)
    Dim e
    Static dic As Object
    If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary")
    dic.RemoveAll
    For Each e In rng.Value
        If e <> "" Then dic(e) = Empty
        If dic.Count = ref Then Exit For
    Next
    If dic.Count >= ref And ref <= dic.Count Then
        FilterUnique = dic.keys()(ref - 1)
    Else
        FilterUnique = ""
    End If
End Function

So after adding this VBA to my spreadsheet, that has a table named 'Transactions' with a column called 'Batch', I just copied this formula =FilterUnique(Transactions[Batch],ROW(AD1)) down as many rows as necessary in a separate table (only possible because the formula doesn't need an array). This code is almost 4 times faster than the original code.

Thanks to Jindon from the www.excelforum.com site for his assistance.