Create a Dictionary with composite key as identifier (VBA)-CodePudding

I'm struggling to find a way to create a dictionary with 2 columns as key identifier. I can't use just one cause it wouldnt be unique. The nameRng and operRng of a row would be unique.

Here's some code

    Dim LstRw As Long, Rng As Range, cell As Range, cell2 As Range
    Dim Dict As Object
    

    Set nameRng = Range(Range("A2"), Range("A2").End(xlDown))
    Set operRng = Range(Range("B2"), Range("B2").End(xlDown))
    Set saisieRng = Range(Range("C2"), Range("C2").End(xlDown))
                              
    Set Dict = CreateObject("Scripting.Dictionary")
    
    LstRw = Cells(Rows.Count, "A").End(xlUp).Row
    
    For Each cell In nameRng

         For Each cell2 In operRng
         Dict.Add cell.Value, cell2.Value
         Next
        
    Next

Running this, I get an error "Key already exist" but I don't understand why.

Thanks in advance !

CodePudding user response：

Use one For Each loop, and Offset:

For Each cell In nameRng
    Dim key As String
    key = cell.Value & "," & cell.Offset(,1).Value

    Dim itm As Variant
    itm = cell.Offset(,2).Value

    Dict.Add key, itm
Next

If your columns are not adjacent, then use a For...Next loop:

For i = 1 to nameRng.Count
    Dim key As String
    key = nameRng.Cells(i).Value & "," & operRng.Cells(i).Value
    
    Dim itm As Variant
    itm = saisieRng.Cells(i).Value

    Dict.Add key, itm
Next

CodePudding user response：

In order to extract unique values for both columns, please use the next way:

Sub testUniqueKeys()
  Dim sh As Worksheet, lastR As Long, arr, i As Long, dict As Object
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  
  Set dict = CreateObject("Scripting.Dictionary")
  arr = sh.Range("A2:C" & lastR).Value
  For i = 1 To UBound(arr)
        dict(arr(i, 1)) = vbNullString
        dict(arr(i, 2)) = vbNullString
        dict(arr(i, 3)) = vbNullString
  Next i
  Debug.Print Join(dict.Keys, "|") 'to visually see (in Immediate Window) the resulted keys
End Sub

If you want extracting all values from the third column in a dictionary key obtained by concatenation of the first two, please try the next adapted way:

Sub testUniqueConcatKeys()
  Dim sh As Worksheet, lastR As Long, arr, i As Long, dict As Object
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  
  Set dict = CreateObject("Scripting.Dictionary")
  arr = sh.Range("A2:C" & lastR).Value
  For i = 1 To UBound(arr)
        If Not dict.Exists(arr(i, 1) & arr(i, 2)) Then
            dict.Add arr(i, 1) & arr(i, 2), arr(i, 3)
        Else
            dict(arr(i, 1) & arr(i, 2)) = dict(arr(i, 1) & arr(i, 2)) & "|" & arr(i, 3)
        End If
  Next i
  Debug.Print Join(dict.Keys, ":")
  Debug.Print Join(dict.Items)
End Sub

Something similar is shown by the other answer, placed before I edited the code. So, it should be marked being the first one understanding what you want. Mine, shows all occurrences, if is the case.

If none of the two variant, please edit your question and try doing what I recommended in my comment...