CODEWITHSUNDEEP
excelexcel-2010vba
RPh_Coder
RPh_Coder

Reputation: 883

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

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

Upvotes: 1

Views: 2852

Answers (2)

RPh_Coder
RPh_Coder

Reputation: 883

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".

Upvotes: 1

Alex P
Alex P

Reputation: 12489

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

Upvotes: 4

Related Questions