What is an ideal way to get unique values into a multidimensional array in Excel VBA?

Question

I have the following code, which populates my array nicely. The problem is that some of the values are duplicates and I only want unique data. I have seen examples for single-dimensional arrays, but nothing for a multi-dimensional array.

For my use here, the "A" column is an identifier and the "B" column is a name. For example, "A2" may be "A1234" and "B2" would be "Air Rifle". The code in the "A" column will always be unique to the description in the "B" column, so I only need to search duplicates in the "A" column; though, I would be curious about examples that worked each way.

Thanks in advance for any assistance.

Sub testme()
    Dim myArray As Variant

    myArray = Range("A2:B20")
End Sub

Have you seen [this](http://stackoverflow.com/questions/23481700/deleting-duplicates-in-a-vba-array)? — Ioannis, Nov 28 '14 at 17:52
And [this](http://stackoverflow.com/questions/5382431/loading-an-array-with-only-unique-values?lq=1) — Alex P, Nov 28 '14 at 17:57
@Ioannis, I could only get that to add the unique values as separate entries in a single-dimensional array. I was able to use Alex P's entry and tweak it to work. Thank you for your assistance though! — RPh_Coder, Nov 28 '14 at 19:11

Alex P · Accepted Answer · 2014-11-29T09:48:59.250

4

Please check the comments from Ioannis and Alex P first.

This would work using a dictionary object:

Sub UniqueValuesOnly()
    Dim myArray As Variant, a As Integer
    Dim dict As Object

    Set dict = CreateObject("Scripting.Dictionary")
    myArray = Range("A2:B20")

    For a = 1 To UBound(myArray, 1)
        If Not dict.Exists(myArray(a, 1)) Then
            dict.Add myArray(a, 1), myArray(a, 2)
        End If
    Next a

    For Each Key In dict
        Debug.Print Key, dict(Key)  //Let's print out the content to see if it worked...
    Next Key

    Set dict = Nothing
End Sub

edited Nov 29 '14 at 09:48

answered Nov 28 '14 at 18:05

Alex P

12,249
5
51
70

This is fantastic. I saw other examples with using a dictionary entry, but I did not understand how to add the second dimension to it. Thank you! – RPh_Coder Nov 28 '14 at 19:09

RPh_Coder · Answer 2 · 2014-12-01T18:13:56.360

I took the link from Alex P's comment from my question and tweaked to work. I prefer the elegance of the dictionary entry, so I marked that as the answer, but I wanted to share the tweak in case it helps someone else.

Sub Test()
    Dim firstRow As Integer, lastRow As Integer, cnt As Integer, iCell As Integer
    Dim myArray()

    ReDim myArray(1, 0)
'    Debug.Print UBound(myArray)

    cnt = 0
    firstRow = 2
    lastRow = 20

    For iCell = firstRow To lastRow
        If Not IsInArray(myArray, Cells(iCell, 2)) Then
            ReDim Preserve myArray(0 To 1, 0 To cnt)
            myArray(0, cnt) = Cells(iCell, 1)
            myArray(1, cnt) = Cells(iCell, 2)
            cnt = cnt + 1
        End If
    Next iCell
End Sub

Function IsInArray(myArray As Variant, val As String) As Boolean
    Dim i As Integer, found As Boolean
    found = False

    If Not Len(myArray(0, 0)) > 0 Then
        found = False
    Else
        For i = 0 To UBound(myArray, 2)
            If myArray(0, i) = val Then
               found = True
               Exit For
            End If
        Next i
    End If
    IsInArray = found
End Function

Edited to include @PatrickLepelletier's suggestion and exit the loop after "found = true".

after `found=true`, you can add `exit for` – Patrick Lepelletier Nov 29 '14 at 00:34 — Patrick Lepelletier, Nov 29 '14 at 00:34

What is an ideal way to get unique values into a multidimensional array in Excel VBA?

2 Answers2