Best way to get unique values in excel vba ?

Hello!

I am working in excel 2007, in vba.

I have a range of cells that contain various values / data. I want to exctract only the unique values/occurences and remove any duplicates.

My ideal "result" would be an array holding each unique value with the data type of that value preserved.

I have seen similar solutions using user functions, or specialized versions of the advanced filter from vba.
But my question is... which way is the best way?
and by best I mean that it fulfills these criteria:
- as fast as possible (avoiding any unnessecary looping etc)
- can accept any value types (dates, strings, numbers whatever...)
- can be fully used from vba

I have found some functions, for example:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_24147270.html?sfQueryTermInfo=1+10+30+excel+find+uniqu+valu+vba

but it seems to be written specifically to work on string values, and gives unexpected results when I pass a range of cells holding date data type.

So how should I do it?
Advanced filter? or custom function? or some other way?
regardless of which, could you please provide me with an example including code?
thanks!
LVL 5
NiklasMollerAsked:
Who is Participating?
 
StephenJRConnect With a Mentor Commented:
Advanced Filter is pretty good. So if you had data in A1 and down this would give you a list of unique values in G1 and down:
Sub Macro2()

Range("A1", Range("A1").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("G1"), Unique:=True

End Sub

Open in new window

0
 
TracyConnect With a Mentor VBA DeveloperCommented:
I think the best way to do this is to use the Dictionary class.  You can store unique values with different data types in a dictionary.

Have a look at Patrick's article (complete with code) on this and the difference between a Collection, which can only hold a single data type:

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_3391-Using-the-Dictionary-Class-in-VBA.html
0
 
StephenJRCommented:
Dictionary is very useful. I seem to recall having some problems storing numerical entries at one point, but could have been my ineptitude.
0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
gbanikCommented:
Here is one of the way... pass your range to this subroutine to remove duplicates (assumption made is your range is in ONE column)

Run the macro Test using CRTL + SHFT + T
Option Explicit

Public Sub Test()
DeleteDuplicates Application.Range("A1:A140")
End Sub

Public Sub DeleteDuplicates(oRange As Range)
Dim nStart As Long, nEnd As Long, sCol As String, oDelRange As Range, oCell As Range
Application.ScreenUpdating = False
Set oRange = oRange.Columns(1)
oRange.Offset(, 1).EntireColumn.Insert
nStart = oRange.Row
nEnd = oRange.Rows(oRange.Rows.Count).Row
sCol = Split(oRange.Cells(1).Address, "$")(1)
oRange.Offset(, 1).Formula = "=IF(COUNTIF(" & sCol & "$" & nStart & ":" & sCol & nStart & "," & sCol & nStart & ")=COUNTIF(" & sCol & "$" & nStart & ":" & sCol & "$" & nEnd & "," & sCol & nStart & "),0,1)"
For Each oCell In oRange.Cells
    If oCell.Offset(, 1).Value = 1 Then
        If oDelRange Is Nothing Then
            Set oDelRange = oCell.Resize(, 2)
        Else
            Set oDelRange = Union(oDelRange, oCell.Resize(, 2))
        End If
    End If
Next
oDelRange.Delete xlShiftUp
oRange.Offset(, 1).EntireColumn.Delete
Application.ScreenUpdating = True
End Sub

Open in new window

Remove-Duplicates.xlsm
0
 
StephenJRCommented:
Just tested it and it all seems fine so not sure what I was doing before.
0
 
NiklasMollerAuthor Commented:
Thanks for many interesting answers!
@stephenjr:
You mention using the Dictionary class. Could you give me some code that adresses my problem using that class? Would it not mean that i would have to loop over all the values and do some kind of comparison? Is looping all cells really quicker than advanced filter? Thanks!
0
 
StephenJRConnect With a Mentor Commented:
Actually broomee9 mentioned Dictionary and you should read the article referred to. Here is a simple example - press the button in the attachment. Transferring the cells into an array speeds things up.
Sub x()

Dim oDic As Object, vData As Variant, n As Long, r As Long

vData = Range("A1", Range("A1").End(xlDown)).Value
Set oDic = CreateObject("Scripting.Dictionary")

With oDic
    For r = 1 To UBound(vData, 1)
        If Not IsEmpty(vData(r, 1)) And Not .Exists(vData(r, 1)) Then
            n = n + 1
            .Add vData(r, 1), n
        End If
    Next r
    Range("G1").Resize(.Count) = Application.Transpose(.Keys)
End With

End Sub

Open in new window

Book1.xlsm
0
 
NiklasMollerAuthor Commented:
Yes of course,sorry i got it backwards :) i will try your script and i will read that article! Get back to you all soon! Thanks
0
 
NiklasMollerAuthor Commented:
ok heres a status update.
@Stephen JR
I tried your provided sub, and I tried to measure the time it took to loop through 100,000 cells in one column containing random numbers
Printing the numbers using a for loop took about 5 seconds.
Extracting the unique values and printing them to the G column takes less than 0,5 seconds!
almost instantaneous! so thats good :)

and that is 100,000 cells, I will rarely approach those masses of cells.
so anything less than less than that will be close to lightning fast!

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.