Get unique items from large array fast

pulsar777 · Nov 24th 2016

Hi everyone,

I'd have 2 large ranges:
A1:A50000
B1:B50000

Both contain duplicates.
I'd like to determine which unique values from A range are contained in B range.

I thought of ruling out these methods:
a) Looping thru arrays and making array of unique values
b) Range.AdvancedFilter Unique:=True
c) Creating pivot tables

I found on Ozgrid this nice looking method:

Code

Dim V As Variant
    With Range("A1:A50000")
        V = Filter(Evaluate("TRANSPOSE(IF(COUNTIF(OFFSET(" & _
            .Address & ",,,ROW(1:" & .Rows.Count & "))," & _
            .Address & ")=1," & .Address & "))"), False, 0)
    End With

But it still takes long processing time.

What would you suggest as fastest way ?

**KjBox** · Nov 24th 2016

Re: Get unique items from large array fast

Try this

Code

Sub Test()
    Dim x, y, z, i As Long
    
    With Cells(1).CurrentRegion
        x = .Value
        With CreateObject("system.collections.arraylist")
        
'// Assumption made that Row 1 is a header row
'// If not then change next line to:   For i = 1 To UBound(x, 1)


            For i = 2 To UBound(x, 1)
                If Not .contains(x(i, 1)) Then .Add x(i, 1)
            Next
            .Sort: y = .toarray
        End With
        ReDim z(1 To 1)
        For i = 0 To UBound(y)
            If Not IsError(Application.Match(y(i), .Columns(2), 0)) Then
                If z(1) <> "" Then ReDim Preserve z(1 To UBound(z) + 1)
                z(UBound(z)) = y(i)
            End If
        Next
    End With
    
'// Array z will now contain unique values from Column A that are in Column B
    
End Sub

Display More

If you want to display the result then add this line above "End Sub" (change [d2] to whatever cell you want to use to start the list display).

Code

[d2].Resize(UBound(z)) = Application.Transpose(z)

pulsar777 · Nov 25th 2016

Re: Get unique items from large array fast

It is relatively fast !
Despite the loop and Redim Preserve

Thanks a lot, KjBox!

**KjBox** · Nov 25th 2016

Re: Get unique items from large array fast

You're welcome.

**KjBox** · Nov 26th 2016

Re: Get unique items from large array fast

You may well find that using a Dictionary rather than ArrayList will give further speed improvement.

Code

Sub Test()
    Dim x, xx, y, z, i As Long
     
    With Cells(1).CurrentRegion
        x = .Value
        y = Application.Transpose(.Columns(2))
    End With
    With CreateObject("scripting.dictionary")
        For i = 2 To UBound(x, 1)   '// Assumes Row 1 is header row
            If Not IsError(Application.Match(x(i, 1), y, 0)) Then
                xx = .Item(x(i, 1))
            End If
        Next
        
'// Choose 1 of the 2 lines below (to save result in an array (z) or to display in cell D2 (change to suit))


        z = .keys
        [d2].Resize(.Count) = Application.Transpose(.keys)
    End With
          
End Sub

Display More

Thanks to Pike for pointing out to me the advantage of Dictionary over Arraylist

pulsar777 · Nov 27th 2016

Re: Get unique items from large array fast

KjBox, thanks again.

I think I'll stick with the Collections.
Dictionaries seem to be way slower over such large arrays.

I also found strange that when I had 100K rows rather than 50K,
application could transpose only somewhat over 34K items,
unlike all 50K in original example.

But anyway, your help was very descriptive and appreciated.
Keep up the same good approach !

**KjBox** · Nov 28th 2016

Re: Get unique items from large array fast

Sorry my mistake for using

Code

y = Application.Transpose(.Columns(2))

Normally a one dimensional array, when used in Application.Match, is slightly faster than a two dimensional array. I forgot about you size of data.

I have corrected that, and modified the Collections.Arraylist code to make it more efficient.

Try both these procedures to see which is faster for you. You will get a message box saying how many seconds it took for the code to run.

I would be interested to know the times taken for your full set of data, even on a very small set of test data I find the Dictionary method to be appreciably faster.

Code

Sub Test_Dictionary()
    Dim x, xx, y, z, i As Long
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    StartTime = Timer


    With Cells(1).CurrentRegion
        x = .Columns(1)
        y = .Columns(2)
    End With
    With CreateObject("scripting.dictionary")
        For i = 2 To UBound(x, 1) '// Assumes Row 1 is header row
            If Not IsError(Application.Match(x(i, 1), y, 0)) Then
                xx = .Item(x(i, 1))
            End If
        Next
         
         '// Choose 1 of the 2 lines below (to save result in an array (z) or to display in cell D2 (change to suit))
         
        z = .keys
        [d2].Resize(.Count) = Application.Transpose(.keys)
    End With
    SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "Dictionary method took " & SecondsElapsed & " seconds", vbInformation
     
End Sub


Sub Test_ArrayList()
    Dim x, y, z, i As Long
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    StartTime = Timer
    
    With Cells(1).CurrentRegion
        x = .Columns(1)
        y = .Columns(2)
    End With
    With CreateObject("system.collections.arraylist")
        For i = 2 To UBound(x, 1) '// Assumes Row 1 is header row
            If Not IsError(Application.Match(x(i, 1), y, 0)) Then
                If Not .contains(x(i, 1)) Then .Add x(i, 1)
            End If
        Next
        z = .toarray
        [d2].Resize(.Count) = Application.Transpose(z) '// Delete this line if display of result not required
    End With
    SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "ArrayList method took " & SecondsElapsed & " seconds", vbInformation
     
End Sub

Display More

**Kenneth Hobson** · Nov 28th 2016

Re: Get unique items from large array fast

I guess this seems to be a good comparison of collection versus dictionary. https://colinlegg.wordpress.co…or-unique-values-vba-udf/
Of course even at 50% slower, does 1.5 seconds really seem that much longer than 1 second? Part of the speed advantage is likely due to collections being case insensitive.

In some speed tests that I looked at some time back, the speed varied significantly in multiple calls. If it is a one-off deal, the comparison should be based on a fresh start of Excel for each test. Speed can be affected by the way the macros are played as well.

KjBox, like you, it might be fun to run some speed tests for a large matrix. All things being equal, speed-wise, early binding methods should be faster than late binding methods. https://support.microsoft.com/en-us/kb/245115

Here are a few unique routines that I use.

Code

Public Function UniqueValues(theRange As Range, Optional tfVisible = True) As Variant
    Dim colUniques As New VBA.Collection
    Dim vArr As Variant
    Dim vCell As Variant
    Dim vLcell As Variant
    Dim oRng As Excel.Range
    Dim i As Long
    Dim vUnique As Variant
    If tfVisible = False Then
      'Set oRng = Intersect(theRange.SpecialCells(xlCellTypeVisible), theRange.Parent.UsedRange)
      Set oRng = theRange.SpecialCells(xlCellTypeVisible)
      Else
       'Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
       Set oRng = theRange
    End If
    vArr = oRng
    On Error Resume Next
    For Each vCell In vArr
        If Len(CStr(vCell)) > 0 Then
             colUniques.Add vCell, CStr(vCell)
        End If
    vLcell = vCell
    Next vCell
    On Error GoTo 0
 
    ReDim vUnique(1 To colUniques.Count)
    For i = LBound(vUnique) To UBound(vUnique)
      vUnique(i) = colUniques(i)
    Next i
 
    UniqueValues = vUnique
End Function

Display More

Code

' Early Binding method requires Reference: MicroSoft Scripting Runtime, scrrun.dll
Function UniqueArrayByDict(Array1d As Variant, Optional compareMethod As Integer = 0, _
  Optional tfStripBlanks = False) As Variant
  'Dim dic As Object 'Late Binding method - Requires no Reference
  'Set dic = CreateObject("Scripting.Dictionary")  'Late or Early Binding method
  Dim Dic As Dictionary     'Early Binding method
  Set Dic = New Dictionary  'Early Binding Method
  Dim e As Variant
  Dic.CompareMode = compareMethod
  'BinaryCompare=0
  'TextCompare=1
  'DatabaseCompare=2
  For Each e In Array1d
    If Not Dic.Exists(e) Then
      If tfStripBlanks And e <> "" Then Dic.Add e, Nothing
      If tfStripBlanks = False Then Dic.Add e, Nothing
    End If
  Next e
  UniqueArrayByDict = Dic.Keys
End Function

Display More

pulsar777 · Nov 29th 2016

Re: Get unique items from large array fast

Hi, thank you both, this is really useful.

At 2 columns of 100K of data,
Collections took 5 secs while Dictionaries only 3.1 secs.
Both are case insensitive.
Is there a way to apply Text compare rather than binary? But still, I can overcome it with UPPER worksheet function just in case.

KjBox: the Application.Match failed with type mismatch, cause it probably expected range as 2nd argument (rather than y).

**KjBox** · Nov 29th 2016

Re: Get unique items from large array fast

You can do Text Compare when using a Dictionary

Code

Sub Test_Dictionary()
    Dim x, xx, y, z, i As Long
     
    With Cells(1).CurrentRegion
        x = .Columns(1)
        y = .Columns(2)
    End With
    With CreateObject("scripting.dictionary")
        .CompareMode = 1
        For i = 2 To UBound(x, 1) '// Assumes Row 1 is header row
            If Not IsError(Application.Match(x(i, 1), y, 0)) Then
                xx = .Item(x(i, 1))
            End If
        Next
         
         '// Choose 1 of the 2 lines below (to save result in an array (z) or to display in cell D2 (change to suit))
         
        z = .keys
        [d2].Resize(.Count) = Application.Transpose(.keys)
    End With
     
End Sub

Display More

**KjBox** · Nov 29th 2016

Re: Get unique items from large array fast

Quote

KjBox: the Application.Match failed with type mismatch, cause it probably expected range as 2nd argument (rather than y).

Application.Match works perfectly well with either an array or a worksheet range. What columns is your data in?

**Kenneth Hobson** · Nov 29th 2016

Re: Get unique items from large array fast

I showed how to set the compare mode for the dictionary object in my example and how to set early binding and late binding.

Most will code in early binding but post in late binding. There are lots or pros and cons for both methods of binding. I usually post late binding method solutions but if the user takes the time to learn early binding, intellisense alone is worth it since they are just learning. Imagine trying to program using the Excel object if it were not early bound for you already. It would just be a scripting language like vbs then.

Get unique items from large array fast

Participate now!

Share