Copy all dictionary items to a specific range efficiently

user_7131122 0
Viewed 659

I have a dictionary containing a bunch of values that I want to print in a range of cells (a column) in a swift and efficient manner. This range already contains values, that might or might not be the same as in the dictionary.

The first code I used after filling the dictionary was the following:

For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    dKey = (Cells(i, 1))
    If Not Cells(i, 2) = dict(dKey) Then Cells(i, 2) = dict(dKey)
Next i

This simply loops the range, and replaces every value that isn't the same as in the dictionary.
The range values are the same as they dictionary keys For the sake of this test, let's assume that each cell is different, so last row is Cells(i, 2) = dict(dKey) to write in each cell.

Now, to me this looks like it could end up writing a whole lot to the sheet, so I figured I could dump it all in one go.

I could only find how to print an array, using the following method:

Set destination = Range("B1")
Set destination = destination.Resize(UBound(arr), 1)
destination.Value = Application.Transpose(arr)

While that seems fast, my data is in a dictionary still. I tried converting my dictionary to an array first with:

ReDim arr(0 To dict.Count) As Variant
For i = 0 To dict.Count - 1
   arr(i) = dict.Items()(i)
Next i

But it turns out, this in itself might take more time (in my test at least) than just printing the dictionary.
With 10 000 rows, this approach was slower, but with 100 000 rows, it was faster. Thus the conversion seems to take me a second either way, but the "printing" is much faster.

Is there a way to do something similar with the dictionary without converting it, making it faster for both scenarios?

vba excel dictionary
2 Answers

You can do something like this.

Reshaping the key/item arrays into a single 2-D array avoids the Transpose() limitation

Sub Tester()

    Dim dict As Object, n As Long, t, arrK, arrV, data
    
    Set dict = CreateObject("scripting.dictionary")
    
    t = Timer
    For n = 1 To 100000
        dict.Add n, "Val_" & n
    Next n
    Debug.Print "Fill dictionary", Timer - t

    t = Timer
    arrK = dict.keys
    arrV = dict.items
    ReDim data(1 To UBound(arrK) - 1, 1 To 2)
    For n = 1 To UBound(arrK) - 1
        data(n, 1) = arrK(n - 1)
        data(n, 2) = arrV(n - 1)
    Next n
    ActiveSheet.Range("B1").Resize(UBound(data, 1), 2).Value = data
    Debug.Print "Add to range", Timer - t
    
End Sub

output:

Fill dictionary       0.3984375 
Add to range          0.296875
user_4788840

You can speed up the Dictionary->Array conversion significantly.

It turns out that for some reason, looping through a Dictionary is much, much faster when using an iterator. Try replacing the code

ReDim arr(0 To dict.Count) As Variant
For i = 0 To dict.Count - 1
   arr(i) = dict.Items()(i)
Next i

with

ReDim Arr(0 To Dict.Count) As Variant
Dim it As Variant
Dim i as Long
i=0
For Each it In Dict.Items
   Arr(i) = it
   i=i+1
Next it

And then assigning the resulting array to the range.

user_122874570
Related