Speeding Up Unique Value List Function

Hi all,

Long time visitor, first time poster. I was able to create this following Frankenstein function that will take in an array or range and pick out the unique values, then enter them into a comma separated list. I created it from various UDFs I've seen on this site and elsewhere. This function needs to be able to take arrays, not just ranges, as I use the IF function extensively within the UDF.

The problem I am having with this is that running this function about 2000 times will take over an hour to run. I don't believe the code is properly optimized and would appreciate any help from some of the VBA experts on this site. Let me know if I can provide any more details that might be helpful.

Thanks.

Function UniqueIf(MyArray As Variant, Optional ByVal iFuncNum As Integer = 1, Optional ByVal sDelim As String = ", ") As Variant

    Dim oDict As Object
    Dim sTxt As String
    Dim i As Long
    Dim j As Long
    Dim nElements As Long
    Dim tElements() As Variant
    Dim nUnique As Long


    Set oDict = CreateObject("Scripting.Dictionary")
    With oDict

    nElements = UBound(MyArray)

    ReDim tElements(1 To nElements)

    nUnique = 0 'To correctly enter first unique value when nUnique is increased by 1 below

    For i = 1 To nElements
        
    If MyArray(i, 1) = "" Then
    'Exit For
    GoTo NextIteration
    End If
        
        If MyArray(i, 1) > "" Then
                
                For j = 1 To nUnique
                    If tElements(j) = MyArray(i, 1) Then
                Exit For
                    End If
        
                Next j
                    
            If j > nUnique Then
                nUnique = nUnique + 1
                tElements(nUnique) = MyArray(i, 1)
                    
'                .Add rCell.Text, rCell.Text
                sTxt = sTxt & sDelim & MyArray(i, 1)
        End If
    End If

NextIteration:  Next i
    End With
    
    If iFuncNum = 1 Then
        UniqueIf = Mid(sTxt, Len(sDelim) + 1)
    ElseIf iFuncNum = 2 Then
        UniqueIf = nUnique
    Else
        UniqueIf = CVErr(xlErrValue)
    End If


End Function

Is this how you wanted?

Function UniqueIf(MyArray As Variant, Optional ByVal iFuncNum As Integer = 1, _
        Optional ByVal sDelim As String = ", ") As Variant

    Dim oDict As Object, e
    Set oDict = CreateObject("Scripting.Dictionary")
    For Each e In MyArray
        If e <> "" Then oDict(e) = Empty
    Next
    UniqueIf = IIf(iFuncNum = 1, Join(oDict.keys, sDelim), oDict.Count)
End Function

Thanks a lot. Both of these are improvements on what I was using. jindon's solution was better, as it took 10 minutes to run for the entire sheet, and the VBA code is just so simple.