Non-Repeating Items in Data - UDF Error

[Juggler_IN]

I want to list only the non-repeating items from a range. Essentially I want to output only non-duplicated items. For example, if range A1:A8 has A, B, C, D, E, F, A, B then I want only C, D, E, F as output. The function I have put together gives all distinct as of now, that is, A, B, C, D, E, F. But, I want it to output C, D, E, F only.

Option Explicit
Option Base 1
Public Function PrintNR(ByRef x As Variant, Optional ByVal y As Boolean) As Variant

' If y = 1, then the function returns a variant count of distinct elements (TRUE).
' If y = 0, then the function returns a variant array of distinct elements (FALSE).
' It must be array-entered into a range of cells (Ctrl+Shift+Enter).

    Dim Bln As Boolean
    
    Dim i As Long
    Dim j As Long
    
    Dim w As Variant
    Dim u() As Variant

    If IsMissing(y) Then y = True

    i = 0
    j = 0

    For Each w In x

        Bln = False
        For i = 1 To j
            If w = u(i) Then
                Bln = True
                Exit For
            End If
        Next i
        If Not Bln And Not IsEmpty(w) Then
            j = j + 1
            ReDim Preserve u(j)
            u(j) = w
        End If

    Next w

    If y Then
        PrintNR = CLng(j)
    Else
        PrintNR = CVar(u)
    End If

End Function

 

[Darren Bartrup]

If you've got Excel 365 you can use =UNIQUE(A1:A8,,TRUE) to return a list of values that are unique in the list, to get the count you'd use =COUNTA(UNIQUE(A1:A8,,TRUE))

If you haven't got the UNIQUE function this code may help.
The formula =Exactly_Once(A1:A8) will return the count, while the array formula =Exactly_Once(A1:A8,FALSE) will return a list of the items. The array formula must be at least as long as your expected count, any extra will return blank any less and you won't get the full list.

Public Function Exactly_Once(Target As Range, Optional CountElements As Boolean = True) As Variant
    Dim rCell As Range
    Dim Once As New Collection
    Dim arr As Variant
    Dim itm As Variant
    Dim x As Long
        
    For Each rCell In Target
        If Application.WorksheetFunction.CountIf(Target, rCell.Value) = 1 Then
            Once.Add rCell.Value
        End If
    Next rCell
    
    If CountElements Then
        Exactly_Once = Once.Count
    Else
        ReDim arr(1 To Target.Count, 1 To 1)
        For Each itm In Once
            x = x + 1
            arr(x, 1) = itm
        Next itm
        
        'If the formula range is more than the items returned fill
        'the rest in with blanks.
        For x = Target.Count - Once.Count + 1 To Target.Count
            arr(x, 1) = ""
        Next x
        Exactly_Once = arr
    End If
    
End Function

 

[Fluff]

Another option

Function JugglerIN(Rng As Range, Optional Flg As Boolean = True) As Variant
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Rng.Value2
   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For i = 1 To UBound(Ary)
         If Not .Exists(Ary(i, 1)) Then
            .Add Ary(i, 1), False
         Else
            .Item(Ary(i, 1)) = True
         End If
      Next i
      For i = .Count - 1 To 0 Step -1
         If .Items()(i) Then .Remove .Keys()(i)
      Next i
      If Flg Then JugglerIN = .Count Else JugglerIN = Application.Transpose(.Keys)
   End With
End Function

 

[Juggler_IN]

@Darren Bartrup;

Not working for all scenarios. If data is:
Amy Ben Chen Dave Eve Ira Dan Ida Chen Ben Stan
...then the output is:
Amy Dan Dave Eve

 

[Darren Bartrup]

Apologies - should check my work more thoroughly. The second For...Next should start

For x = Once.Count + 1 To Target.Count

 

[Fluff]

@Darren Bartrup
You could also just dim the array to the size of the collection, like

Public Function Exactly_Once(Target As Range, Optional CountElements As Boolean = True) As Variant
    Dim rCell As Range
    Dim Once As New Collection
    Dim arr As Variant
    Dim itm As Variant
    Dim x As Long
       
    For Each rCell In Target
        If Application.WorksheetFunction.CountIf(Target, rCell.Value) = 1 Then
            Once.Add rCell.Value
        End If
    Next rCell
   
    If CountElements Then
        Exactly_Once = Once.Count
    Else
        ReDim arr(1 To Once.Count, 1 To 1)
        For Each itm In Once
            x = x + 1
            arr(x, 1) = itm
        Next itm
       
        Exactly_Once = arr
    End If
   
End Function