Storing/Saving a dictionary even after excel is closed - vba

Question

I am having a dictionary, that holds userkey -> username references. (I am using it to store the user name after looking it up in the windows directory based on the current userkey, because I assume it is a very slow process and want to improve the performance)
If I got it right on my searching, my dictionary gets completely cleared when I reopen the excel file, correct?
So I want to save it to one of the sheets, where I want to recreate it from on the next session. (one column should hold the userkey, the other the name).
My code runs, but does not write any values in the fields:
'will store the values on the rule sheets in row 4 following, columns BA and BB
Sub SaveDictToRulesSheet(dict As Object)
'startrow of list on excel sheet
startrow = 4
Dim i As Integer
i = 0
ActiveSheet.Name = "Rules"
For Each key In dict.Keys
Worksheets("Rules").Cells(startrow + i, "BA").Value = key
Worksheets("Rules").Cells(startrow + i, "BB").Value = dict(key)
i = i + 1
Next key
i = 0
End Sub
Any help is greatly appreciated.

Answer 1

So I want to save it to one of the sheets, where I want to recreate it from on the next session. (one column should hold the userkey, the other the name).
Well that part seems fairly simple. What's a little confusing is where you read in your dict. You refer to it, but it's unclear to me where the values are being loaded in. I'm going to show you how I would do it. Hopefully that helps and I've understood the issue properly.
Write your dictionary columns to a blank / current workbook and save. Then create a new sub that operates something like this:
Sub Retrieve_Dict()
Set wbkCSV = Workbooks.Open("Template.xlsx")
Set wshCSV = wbkCSV.Worksheets("Rules")
Set dict = CreateObject("Scripting.Dictionary")
numrows = application.worksheetfunction.counta(wshCSV.Columns(27)) - 5
numcols = 2
set wshRange = wshCSV.Range("BA5").Resize(numrows,numcols)
tempArray = wshRange.value
for i = 1 to ubound(tempArray) ' Read rows, columns, send to dict.
dict.key(tempArray(i, 1)) = tempArray(i, 2)' read values.
Next i
tempArray = Process(dict) ' Func. updating dictionary values.
wshRange.value = tempArray
wbkCSV.Close (True)
End Sub
Of course, you can make the above sub a function if you instead open the workbook outside, then pass the worksheet. The function could return as an Object / Scripting.Dictionary depending on your binding.
Also, note, I may have gotten the offset / row count wrong. But the general principle should apply, I think.

Answer 2

The code bellow:
TestDictionaryOps() - tests writing and reading from sheet
DictionaryToRange() - writes dictionary to sheet
DictionaryFromRange() - reads dictionary from sheet
Paste it in a new standard module, and run it on a new sheet (Sheet4)
Option Explicit
Public Sub TestDictionaryOps()
Dim d As Dictionary
Set d = New Dictionary
d("1") = "a"
d("2") = "b"
d("3") = "c"
DictionaryToRange d, Sheet4
Set d = DictionaryFromRange(Sheet4)
If Not d Is Nothing Then MsgBox "Total Dictionary items: " & d.Count
End Sub
Public Sub DictionaryToRange(ByRef d As Dictionary, _
ByRef ws As Worksheet, _
Optional ByVal startCol As Long = 1)
If Not d Is Nothing And Not ws Is Nothing And startCol > 0 Then
Dim cnt As Long, rng1 As Range, rng2 As Range
cnt = d.Count
If cnt > 0 Then
Set rng1 = ws.Range(ws.Cells(1, startCol + 0), ws.Cells(cnt, startCol + 0))
Set rng2 = ws.Range(ws.Cells(1, startCol + 1), ws.Cells(cnt, startCol + 1))
rng1 = Application.Transpose(d.Keys) 'write all keys to column 1
rng2 = Application.Transpose(d.Items) 'write all items to column 2
Else
MsgBox "Empty Dictionary"
End If
Else
MsgBox "Missing Dictionary or WorkSheet"
End If
End Sub
Public Function DictionaryFromRange(ByRef ws As Worksheet, _
Optional ByVal startCol As Long = 1) As Dictionary
If Not ws Is Nothing And startCol > 0 Then
Dim d As Dictionary, cnt As Long, vArr As Variant, i As Long
Set d = New Dictionary
cnt = ws.UsedRange.Columns(startCol).Cells.Count
vArr = ws.Range(ws.Cells(1, startCol), ws.Cells(cnt, startCol + 1)).Value2
For i = 1 To cnt
d(vArr(i, startCol)) = vArr(i, startCol + 1)
Next
Set DictionaryFromRange = d
Else
MsgBox "Missing WorkSheet"
End If
End Function
Early binding (fast): VBA Editor -> Tools -> References -> Add Microsoft Scripting Runtime
Late binding (slow): CreateObject("Scripting.Dictionary")