Print dictionary to sheet

user_19402221 0
Viewed 58

I have the below code that prints the dictionary to the watch window but how can I get this exact same format printed to a sheet?

    Dim key As Variant
    For Each key In dict
    Set group = dict(key)
    With group
    Debug.Print .name, .rate, .volume
    End With
    Next key
Name1 Rate1 Volume1
Name2 Rate2 Volume2
Name3 Rate3 Volume3
vba excel
2 Answers

One option is to create an array and then dumpy the array to the sheet:

Dim arr As Variant
ReDim arr(1 To dict.Count, 1 To 3)

Dim i As Long
For i = LBound(dict.Items) To UBound(dict.Items)
    arr(i + 1, 1) = dict.Items(i).name
    arr(i + 1, 2) = dict.Items(i).rate
    arr(i + 1, 3) = dict.Items(i).volume
Next

' Write out to sheet
Sheet1.Range("A1").Resize(Ubound(arr, 1), Ubound(arr, 2)).Value = arr
user_92458530

List Properties of Objects Located in a Dictionary

Option Explicit

Sub YourCode()

    Const dFirstCellAddress As String = "A1"

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim dict As Object ' just to compile
    
    '...
    
    Dim rCount As Long: rCount = dict.Count
    If rCount = 0 Then Exit Sub
    Dim cCount As Long: cCount = 3
    
    Dim Data() As Variant: Data = GetDictGroupsProperties(dict)
     
    ws.Range(dFirstCellAddress).Resize(rCount, cCount).Value = Data

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the 'Name', 'Rate' and 'Volume' properties
'               of the objects, contained in the 'items' of a dictionary,
'               in the rows of a 2D one-based three-column array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetDictGroupsProperties(ByVal dict As Object) As Variant()

    Dim Data As Variant: ReDim Data(1 To dict.Count, 1 To 3)
    
    Dim cKey As Variant
    Dim r As Long
    
    For Each cKey In dict.Keys
        r = r + 1
        With dict(cKey)
            Data(r, 1) = .Name
            Data(r, 2) = .Rate
            Data(r, 3) = .Volume
        End With
    Next cKey
    
    GetDictGroupsProperties = Data
    
End Function
user_98140690
Related