function to return unique values to activecell

[john316swan]

Good Morning from California,

I am trying to turn a subroutine that I have borrowed from @hiker95 into a function but I cannot get the output the dictionary to the activecell. I have tried a number of ways, but I just can't figure it out. I have verified that all of the values are being stored in the dictionary, but can't seem to output them to the activecell. Thank you in advance, here is the code:

Function Unique(Duplicated As Range)
Dim d As Object, c As Variant, dup As Long, output As Range

Set output = ActiveCell
Set d = CreateObject("Scripting.Dictionary")
c = Duplicated

For dup = 1 To UBound(c, 1)
    d(c(dup, 1)) = 1
Next dup

'Dim key As Variant
'    For Each key In d.keys
'        Debug.Print key, d(key)
'Next key

Range(output).Resize(d.Count) = Application.Transpose(d.keys)

End Function

 

[lrobbo314]

You don't set an output cell in a UDF. You set the value of the function to the result. See below and let me know if this works for you. The first argument is the range and the second argument is the delimiter you want to use to separate the unique values.

Function UNIQUE(r As Range, del As String) As String
Dim ar() As Variant: ar = r.Value
With CreateObject("System.Collections.ArrayList")
    For i = 1 To UBound(ar)
        If Not .contains(ar(i, 1)) Then .Add ar(i, 1)
    Next i
    UNIQUE = Join(.toArray, del)
End With
End Function

 

[john316swan]

Thanks, I want them to output in a column starting with the activecell:
12345
12346
12347
12348
etc

 

[lrobbo314]

Then you wouldn't use a function, you would use a subroutine.

This could all go into 1 sub, but if you want to pass the range object you can like this.

Sub Main()
UNIQUE Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
End Sub

Sub UNIQUE(r As Range)
Dim ac As Range: Set ac = ActiveCell
Dim ar() As Variant: ar = r.Value
With CreateObject("System.Collections.ArrayList")
    For i = 1 To UBound(ar)
        If Not .contains(ar(i, 1)) Then .Add ar(i, 1)
    Next i
    ac.Resize(.Count, 1).Value = Application.Transpose(.toarray)
End With
End Sub

 

[Fluff]

What version of Xl are you using?

 

[john316swan]

What version of Xl are you using?

Professional Plus 2016

 

[john316swan]

Then you wouldn't use a function, you would use a subroutine.

This could all go into 1 sub, but if you want to pass the range object you can like this.

Sub Main()
UNIQUE Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
End Sub

Sub UNIQUE(r As Range)
Dim ac As Range: Set ac = ActiveCell
Dim ar() As Variant: ar = r.Value
With CreateObject("System.Collections.ArrayList")
    For i = 1 To UBound(ar)
        If Not .contains(ar(i, 1)) Then .Add ar(i, 1)
    Next i
    ac.Resize(.Count, 1).Value = Application.Transpose(.toarray)
End With
End Sub

Thank you, i was hoping to have the flexibility to do this. I hate google sheets, but they have a function that does exactly what I am looking to do.

 

[john316swan]

I know there are several other excel functions that work, they just take time to run when I am going through thousands of id's from various datapoints.

 

[Fluff]

Professional Plus 2016

In that case you can't use any of the new dynamic arrays, which would have been simple.
However a very clunky option would be to use this

Function MyUnique(Duplicated As Range) As Variant
Dim d As Object, c As Variant, dup As Long

Set d = CreateObject("Scripting.Dictionary")
c = Duplicated

For dup = 1 To UBound(c, 1)
    d(c(dup, 1)) = 1
Next dup
MyUnique = Application.Transpose(d.Keys)

End Function

Then select the cells you want the output to go in (eg I2:I25) enter this in the formula bar
=MyUnique(A2:A800)
Then confirm with Control Shift Enter
However if you only select 10 cells & you have 13 results, you'll only see the first 10 & if you have 8 results you'll get #N/A in the remaining cells.

 

[john316swan]

That's perfect...i ended up writing exactly the same thing and it was returning the first value, but now that I select the range that I want it to go to first, it works!!! Thank you. I simply wrote another function to remove all the #N/A and not it works perfectly