VBA iterating over rows of range to create a dictionary of string to array?-CodePudding

I have a excel workbook with the third sheet looks like this:

A        B       C       D        E        F
1        test    test    test     test     test
1        test1   test1   test1    test1    test1
1        test2   test2   test2    test2    test2
2        test    test    test     test     test
3        test    test    test     test     test
4        test    test    test     test     test
5        test    test    test     test     test
6        test    test    test     test     test

And I want to create a dictionary where the first column is the key and the value is a collection of 5 arrays

key: 1
Value: [
    [test1   test1   test1    test1    test1]
    [test2   test2   test2    test2    test2]
    [test   test   test    test    test]
    [""   ""   ""    ""    ""]
    [""   ""   ""    ""    ""]
]

key: 2
Value: [
    [test   test   test    test    test]
    [""   ""   ""    ""    ""]
    [""   ""   ""    ""    ""]
    [""   ""   ""    ""    ""]
    [""   ""   ""    ""    ""]
]

etc.

I want to store this in a global variable before opening the form so that I can use it in functions like onclick():

Public donationDict As Scripting.Dictionary
Option Explicit
Sub ouvrir()
    Dim constData As Range
    Set constData = Range("thirdSheet!A:F")
    Dim rw As Range
    For Each rw In constData.rows

        If donationDict.Exists(rw(0)) Then
            donationDict(rw(0)).Add New Collection
        Else
            donationDict.Add rw(0), New Collection
        End If

    Next rw
    UserForm1.Show
End Sub

CodePudding user response：

Try this out:

Option Explicit

Public donationDict As Scripting.Dictionary

Sub ouvrir()
    Dim data As Range, id, ws As Worksheet
    Dim rw As Range, arr(), numArrCols As Long
    
    Set ws = ThisWorkbook.Worksheets("thirdSheet")
    Set data = ws.Range("A1:F" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    Set donationDict = New Scripting.Dictionary
    
    numArrCols = data.Columns.Count - 1
    ReDim arr(1 To numArrCols) 'empty array
    
    For Each rw In data.Rows
        id = rw.Cells(1).Value
        If Not donationDict.Exists(id) Then
            donationDict.Add id, New Collection 'new key: add key and empty collection
        End If
        donationDict(id).Add _
             OneDimension(rw.Cells(2).Resize(1, numArrCols).Value) 'add the row value as 1D array
    Next rw
    
    For Each id In donationDict.Keys
        Do While donationDict(id).Count < 5
            donationDict(id).Add arr 'add empty array
        Loop
    Next id
    
    ShowDict donationDict 'dump to Immediate window for review
End Sub

'convert a 2D [row] array to a 1D array
Function OneDimension(arr)
    OneDimension = Application.Transpose(Application.Transpose(arr))
End Function


Sub ShowDict(dict)
    Dim k, e
    For Each k In dict.Keys
        Debug.Print "Key: " & k
        Debug.Print "------------------------"
        For Each e In dict(k)
            Debug.Print , Join(e, ",")
        Next e
    Next k
End Sub