Using Microsoft Scripting Runtime Dictionary to Store and then Retrieve Range Objects

DocAElstein

Banned user
Joined
May 24, 2014
Messages
1,336
Hi,


. Since learning here the basic idea about Microsoft Scripting Runtime Dictionary, I have been able to use it successfully for sorting and re organizing lists, particularly where unique values come into play..
. I have read time and time again that all sorts of information can be stored using the Microsoft Scripting Runtime Dictionary, and so I am considering it as an alternative to storing complete Range info as I have been able to do, for example, by creating an Array of Range Objects.
. All my attempts have been unsuccessful to date. I expect I am missing some fundamental points but all googling suggests it should be possible but I have yet to see concrete examples of how to do it.

. Can anyone set me straight or point me in the right direction on this one?

. The following is a simplified example of one of my failed attempts:

. – I consider a Simple spreadsheet with 7 hyperlinks, one in each cells, for cells A21 to A27




[Table="class: grid"][tr][td] [/td][td]
A
[/td][td]
B
[/td][/tr]
[tr][td]
20
[/td][td] [/td][td] [/td][/tr]

[tr][td]
21
[/td][td]
Apple fresh​
[/td][td] [/td][/tr]

[tr][td]
22
[/td][td]
'Bierwurst' (coarse heat-treated sausage in bladder and smo​
[/td][td] [/td][/tr]

[tr][td]
23
[/td][td]
'Breslauer' Lyonaise​
[/td][td] [/td][/tr]

[tr][td]
24
[/td][td]
'Gaisburger Marsch' (potatoes with beef) (1)​
[/td][td] [/td][/tr]

[tr][td]
25
[/td][td]
'Göttinger Blasenwurst'/Krakauer​
[/td][td] [/td][/tr]

[tr][td]
26
[/td][td]
'Heaven and earth' (apples and pot.) with blood sausage (3)​
[/td][td] [/td][/tr]

[tr][td]
27
[/td][td]
'Jägersoße' (thickened brown sauce with mushrooms) (5)​
[/td][td] [/td][/tr]

[tr][td]
28
[/td][td] [/td][td] [/td][/tr]
[/table]


(In my actual sheet these are all hyperlinks which open a Web page when they are clicked on)

. With the code below I attempt to create a simple Microsoft Scripting Runtime Dictionary with 7 entries. The key I assign to the name (Value) of the Hyperlink in the cell, and I attempt to set the item to the Cell as a Range Object.
. There are 3 main parts to the code.
. 1). The background stuff to setting up the Dictionary. I have used this many times when using the Microsoft Scripting Runtime Dictionary for simple values and think it is still applicable to what I am trying to do here.
. 2) A loop to attempt to store the keys and corresponding Range Objects
. 3) A second loop to attempt to retrieve the range objects and put them in an Array of Range Objects

. Observations in the Watch Window show me clearly that 2) and 3) are only dealing with values rather than range objects.

( . 4) Finally the attempt to output the Range confirms that I only have values (Indeed I expect this simple method for outputting an Array in one go might not work fro an Array or range Objects and would possibly need to be replaced by some looping method anyway.?)

. Any help would be appreciated
Thanks
Alan Elston.

Full Code:

Code:
[color=green]'[/color]
[color=darkblue]Option[/color] [color=darkblue]Explicit[/color]
 
[color=green]'[/color]
[color=darkblue]Sub[/color] ScriptingRuntimeDictionaryToStoreRanges()
 
[color=green]' 1)  'Part 1: Setting up Scriptimg Runtime Stuff-----------------------------[/color]
[color=green]' Attempting Using the Microsooft Scripting Runtime Dictionary to store Range Objects[/color]
 
[color=green]'We put the unique values now into a Dictionary for later look up purposes:[/color]
[color=green]'--requireslibrary reference to MS Scripting Runtime (Early Binding)-[/color]
[color=green]'        Tools>>References>>scrolldown and check the box next to Microsoft Scripting Runtime[/color]
[color=green]'  ..Or crashes at next line.....[/color]
 [color=darkblue]Dim[/color] dicLookupTable [color=darkblue]As[/color] Scripting.Dictionary [color=green]'Data held with a unique "Key"or Part Number.[/color]
 [color=darkblue]Set[/color] dicLookupTable = [color=darkblue]New[/color] Scripting.Dictionary
[color=green]' The next two lines are an alternative called Late binding. (But note some Dictionary methods and properties( Such as at the end ####) will not work with it  - in those cases Early Binging must be used.[/color]
[color=green]'        Dim dicLookupTable As Object[/color]
[color=green]'        Set dicLookupTable = CreateObject("Scripting.Dictionary")[/color]
[color=green]' Late Binding is better when sharing files as I am here. Early Binding has the advantage that Excel intellisense[/color]
[color=green]' will then work for the Microsoft Scripüting Runtime stuff and give you suggestions after you type the .dot thing[/color]
 
     dicLookupTable.CompareMode = vbTextCompare [color=green]'Not quite sure wot this does yet[/color]
 
 [color=darkblue]Dim[/color] sKey [color=darkblue]As[/color] [color=darkblue]String[/color] [color=green]'Tempory string for part number or "key" - In this case the name of the thing in first column[/color]
[color=green]'.  A Dictionary in VBA is a collection of objects :you can store all kinds of things in it.[/color]
[color=green]'.  Every item in a Dictionary gets its own unique key, a very important characteristic. A Dictionary can only contain unique keys. That's why you can use the property .keys to create a list of unique strings, numbers or dates.[/color]
[color=green]'.  (Although the Dictionary has not been designed for that purpose it's a nice side effect.)[/color]
 [color=darkblue]Dim[/color] rItem [color=darkblue]As[/color] Range [color=green]'Tempory Range Object for Each cell. I am hoping that assigning a dictionary item to this will force the entry to be taken as a Range.[/color]
[color=green]'End of Part 1 initial set up Of Scripting Runtime------------------------[/color]
 
 [color=darkblue]Dim[/color] wksLkUp [color=darkblue]As[/color] Worksheet: [color=darkblue]Set[/color] wksLkUp = ThisWorkbook.Worksheets("debiNetEnglish") [color=green]'Give Abbreviation methods and properties of Object Worksheets (Intellisense then gives suggestions through use of . Dot[/color]
 [color=darkblue]Dim[/color] Hyp_LinkRow [color=darkblue]As[/color] [color=darkblue]Long[/color], LastRowHyp_Link [color=darkblue]As[/color] Long: [color=darkblue]Let[/color] LastRowHyp_Link = wksLkUp.Cells(Rows.Count, 1).End(xlUp).Row [color=green]'BoundLoopVariable (Rows Count), and Last entry in column 1 found by going to end of Spreadsheet, then coming back up until an entry is found, then get the row using row property from that Range (Cell) Object[/color]
 
 [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'LoopBoundVariableCount used in looping here and at end-----[/color]
 
 [color=green]'  2) 'First Loop: We Try to get the String key as the value/ name of the Hyperlink and the item as the Range Object[/color]
  [color=darkblue]For[/color] i = 21 [color=darkblue]To[/color] LastRowHyp_Link [color=darkblue]Step[/color] 1 [color=green]'Going down each Row..[/color]
    [color=darkblue]If[/color] wksLkUp.Cells(i, 1).Value <> "" [color=darkblue]Then[/color] [color=green]'Only look to assign a unique key if a Hyperlink is there[/color]
    sKey = wksLkUp.Cells(i, 1).Value [color=green]'Give each part to the tempory string variable for comparison below[/color]
         [color=darkblue]If[/color] [color=darkblue]Not[/color] dicLookupTable.Exists(sKey) [color=darkblue]Then[/color] [color=green]' check that the unique value does not already exist.[/color]
         [color=darkblue]Let[/color] dicLookupTable(sKey) = sKey [color=green]'Assigns the part Number a unique(Key) in the Dictionary[/color]
         [color=darkblue]Set[/color] rItem = wksLkUp.Cells(i, 1)
         [color=darkblue]Set[/color] dicLookupTable.Item(sKey) = rItem
         [color=darkblue]Else[/color] [color=green]'Do Noting, that is to say Do not give a unique part nimber if this unique value already exists[/color]
         [color=darkblue]End[/color] [color=darkblue]If[/color]
     [color=darkblue]Else[/color] [color=green]'Make no look for unique key or dictionary entry if cell is empty[/color]
     [color=darkblue]End[/color] [color=darkblue]If[/color]
  [color=darkblue]Next[/color] i
  [color=green]'End of first Loop--------------------------------------------------------[/color]
 
 [color=green]'  ..So the dictionary of unique Range Object items is Hopefully made! So we have all the info we need to make an output array[/color]
 [color=darkblue]Dim[/color] Results() [color=darkblue]As[/color] [color=darkblue]Variant[/color] [color=green]'Array for Output Results. I am hoping that Variant will allow Array to initially see The Dictionary Object and further more accept the (hopefully) given Range Object[/color]
 [color=darkblue]ReDim[/color] Results(1 [color=darkblue]To[/color] dicLookupTable.Count, 1 [color=darkblue]To[/color] 1) [color=green]'Set Row Size from Dictionary size. Must use ReDim as DIM only takes actual numbers, not variables[/color]
[color=green]' 3)  'Start of Second Loop. Attempting to retrieve The stored range objects int an Array[/color]
  [color=darkblue]For[/color] i = 0 [color=darkblue]To[/color] dicLookupTable.Count - 1 [color=darkblue]Step[/color] 1 [color=green]'Go throgth each Distionary entry (noting that the Dictionary index starts at 0, a common annoying practice with these things..)...[/color]
  [color=darkblue]Let[/color] Results(i + 1, 1) = dicLookupTable.Items(i)  [color=green]' Give the unique Range Object item to output array[/color]
  [color=darkblue]Next[/color] i
 [color=green]'End of Second Loop---------------------------------------------------------[/color]
 
[color=green]' 4)  'Finally Output Results-----------------------------------------------------[/color]
[color=darkblue]Let[/color] wksLkUp.Range("E21").Resize(dicLookupTable.Count, 1) = Results() [color=green]'Just a convenient way to put in the output in one go: Resize cell C2 to the size of the output array then make its values equal to the output array NOTE: #### This bit will not work with late binding![/color]
 
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'ScriptingRuntimeDictionaryToStoreRanges[/color]


...............

Sihimpglified basic Code:

Code:
Sub ScriptingRuntimeDictionaryToStoreRangesSiHimpfGlified()
 
 Dim dicLookupTable As Scripting.Dictionary: Set dicLookupTable = New Scripting.Dictionary
     dicLookupTable.CompareMode = vbTextCompare
 
 Dim rItem As Range
 
  For i = 21 To Cells(Rows.Count, 1).End(xlUp).Row Step 1
    If Cells(i, 1).Value <> "" Then
    sKey = Cells(i, 1).Value
         If Not dicLookupTable.Exists(sKey) Then
         Let dicLookupTable(sKey) = sKey
         Set rItem = Cells(i, 1)
         Set dicLookupTable.Item(sKey) = rItem
         End If
     End If
  Next i
 
 ReDim Results(1 To dicLookupTable.Count, 1 To 1)
  For i = 0 To dicLookupTable.Count - 1 Step 1
  Results(i + 1, 1) = dicLookupTable.Items(i)
  Next i
 
 Range("E21").Resize(dicLookupTable.Count, 1) = Results()
 
End Sub



File (XL 2007 “PEListScriptingRuntime.xlsm” Macros in Module “MrExcelScrip_Dick”
https://app.box.com/s/lpjmw8wq9ld39hi5gplgtbfkxwiom02d




Both codes '—require library reference to MS Scripting Runtime (Early Binding)-
' Tools>>References>>scroll down and check the box next to Microsoft Scripting Runtime

For second code delete or comment out Option Explicit
 
Hi

You can if you wish. ……..

. Thanks, that helps to clear up that I have the thing at least a bit understood

……………..

…………. I can't really think of a situation in which it wouldn't make more sense to return the array to a variable and then reference the elements through that variable, in which case you don't need to worry about it.


. Sorry I do not quite follow..

.. in my code I also had this option

Code:
 [color=blue]Dim[/color] rResults() [color=blue]As[/color] [color=blue]Variant[/color]
 [color=blue]Let[/color] rResults() = dicLookupTable.Items()

.. but had to include the extra parenthesis () here

Code:
    [color=lightgreen]'Let arrOut(rws, 1) = rResults(rws - sr).Value2(rws - sr + 1, 1) 'Does not work[/color]
    [color=blue]Let[/color] arrOut(rws, 1) = rResults(rws - sr).Value2()(rws - sr + 1, 1) [color=lightgreen]'Works[/color]

. Are you just suggesting that my use of the Microsoft Scripting Runtime Dictionary would in your experience in such a case not have any advantages?.

…………………………..

. I appreciate they are trivial points, sorry to nerve, I think I am almost there. -

. My thinking was that maybe in some more complicated code retrieving data might be quicker from a Microsoft Scripting Runtime Dictionary compared with a VBA Array. (Again I lack the knowledge / experience there, sorry)

. - Hence, amongst other things I was additionally looking at alternatives to putting that data into the Microsoft Scripting Runtime Dictionary – For example Capturing the entire data in one go as A range object and possibly using VBA to loop in Individual ranges (should that have any advantage?) into The Microsoft Scripting Runtime Dictionary. Here I thought I might be reducing the interaction with the Spreadsheet and so might have speed advantages.


Alan
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
What I meant was that I would assign the result of
Code:
dicLookupTable.Items(rws - sr).Value2
to a variable, and then use that variable to access the elements of the array when needed.
 
Upvote 0
OK,
. I think I am probably with it now.
.
. I think, or am quite sure, I have caused some confusion as I am using in my first code from Post #12 temporarily the Same one Large Range object each time in the loop, as I had not worked out a way to split that up into an Array of Range Objects based on the cell ranges within that single Large Range object yet, (my various question 2) along the way which I am still working on) BTW If I had not done this I would not have stumbled upon the extra () requirement – but that alone was worth it for what I have learnt from you on that one, thanks)

. Your last suggestion will not work in my code 1 from Post #12 as Values2 is an array.


Code:
 [color=lightgreen]'3) Part 3)--transfer range objects from dictionary to array of ranges in one go,[/color]
 [color=blue]Dim[/color] rResults() [color=blue]As[/color] [color=blue]Variant[/color]
 [color=blue]Let[/color] rResults() = dicLookupTable.Items()
 [color=lightgreen]'End part 3)--- NOTE: this gives automatically the 0 to _ convention in rResults Array!.[/color]
 
 [color=lightgreen]'4) Part 4)---Produce output array by looping in VBA[/color]
 [color=blue]Dim[/color] Tempvalue2 [color=blue]As[/color] [color=blue]String[/color]
 [color=blue]Dim[/color] arrOut() [color=blue]As[/color] [color=blue]String[/color]
 [color=blue]ReDim[/color] arrOut(sr [color=blue]To[/color] lr, 1 [color=blue]To[/color] 1)
    [color=blue]For[/color] rws = sr To lr [color=blue]Step[/color] 1 [color=lightgreen]'Input Array of Ranges[/color]
 
    [color=blue]Let[/color] Tempvalue2 = rResults(rws - sr).Value2
   
    [color=green]'Let arrOut(rws, 1) = Tempvalue2'[/color][color=red]Errors Type incompatible[/color]
 
    [color=blue]Next[/color] rws
 [color=lightgreen]'End part 4)----------------------------------[/color]


In my second code it would:

Code:
 [color=lightgreen]'3) Part 3)--transfer range objects from dictionary items to Array[/color]
 [color=blue]Dim[/color] rResults() [color=blue]As[/color] [color=blue]Variant[/color] [color=lightgreen]'[/color]
 [color=blue]Let[/color] rResults() = dicLookupTable.Items()
 [color=lightgreen]'End part 3)--- NOTE: this gives automatically the 0 to _ convention in rResults Array!.[/color]
 
 [color=lightgreen]'4) Part 4)---Produce output array by looping in VBA[/color]
 [color=blue]Dim[/color] arrOut() [color=blue]As[/color] [color=blue]String[/color] [color=lightgreen]'[/color]
 [color=blue]ReDim[/color] arrOut(sr [color=blue]To[/color] lr, 1 [color=blue]To[/color] 1)
 [color=blue]Dim[/color] Tempvalue2 [color=blue]As[/color] [color=blue]String[/color]
    [color=blue]For[/color] rws = sr To lr [color=blue]Step[/color] 1 [color=lightgreen]'Input Array of Ranges[/color]
    [color=blue]Let[/color] Tempvalue2 = dicLookupTable.Items(rws - sr).Value2
    [color=blue]Let[/color] arrOut(rws, 1) = Tempvalue2
    [color=blue]Next[/color] rws
 [color=lightgreen]'End part 4)----------------------------------------[/color]


. as indeed seems to to work with .Value (although strangely in the watch window for rResults() does not appear to give me that option? )


Code:
 [color=lightgreen]'3) Part 3)--transfer range objects from dictionary items to Array[/color]
 [color=blue]Dim[/color] rResults() [color=blue]As[/color] [color=blue]Variant[/color] [color=lightgreen]'[/color]
 [color=blue]Let[/color] rResults() = dicLookupTable.Items()
 [color=lightgreen]'End part 3)--- NOTE: this gives automatically the 0 to _ convention in rResults Array!.[/color]
 
 [color=lightgreen]'4) Part 4)---Produce output array by looping in VBA[/color]
 [color=blue]Dim[/color] arrOut() [color=blue]As[/color] [color=blue]String[/color] [color=lightgreen]'[/color]
 [color=blue]ReDim[/color] arrOut(sr [color=blue]To[/color] lr, 1 [color=blue]To[/color] 1)
 [color=blue]Dim[/color] Tempvalue2 [color=blue]As[/color] [color=blue]String[/color]
    [color=blue]For[/color] rws = sr To lr [color=blue]Step[/color] 1 [color=lightgreen]'Input Array of Ranges[/color]
    [color=blue]Let[/color] Tempvalue2 = dicLookupTable.Items(rws - sr).Value
    [color=blue]Let[/color] arrOut(rws, 1) = Tempvalue2
    [color=blue]Next[/color] rws
 [color=lightgreen]'End part 4)----------------------------------------[/color]


. But I think I have confused the issue along the way and bothered you enough on this one, sorry...


Many thanks again

.. I think I finally have it, and if not my fault for confusing the issue. (Just trying to find a simple way now to split that one Range Object of multiple cells into an Array of single cell range objects. Then my academic curiosity is satisfied)

Alan
 
Upvote 0
I wasn't suggesting a string variable. I meant to use:
Code:
 Dim vTemp
vTemp = dicLookupTable.Items(rws - sr).Value2
Let arrOut(rws, 1) = vTemp(rws - sr + 1, 1)
rather than
Code:
 Let arrOut(rws, 1) = dicLookupTable.Items(rws - sr).Value2()(rws - sr + 1, 1)
 
Upvote 0
Hi,

I wasn't suggesting a string variable. I meant to use:
……….

. One of my many thoughts was that you may have meant that. But I tried and could not get it to work. (Probably because of a typo – my brain is hurting now a bit on this one)……
…. But thanks to your reply I gave it a last try…..
. Got this to work…

Code:
 [color=lightgreen]'3) Part 3)--transfer range objects from dictionary to array of ranges in one go,[/color]
 [color=blue]Dim[/color] rResults() [color=blue]As[/color] [color=blue]Variant[/color]
 [color=blue]Let[/color] rResults() = dicLookupTable.Items()
 [color=lightgreen]'End part 3)--- NOTE: this gives automatically the 0 to _ convention in rResults Array!.[/color]
 
 [color=lightgreen]'4) Part 4)---Produce output array by looping in VBA[/color]
 [color=blue]Dim[/color] vTemp [color=blue]As[/color] [color=blue]Variant[/color]
 
 [color=blue]Dim[/color] arrOut() [color=blue]As[/color] [color=blue]String[/color]
 [color=blue]ReDim[/color] arrOut(sr [color=blue]To[/color] lr, 1 [color=blue]To[/color] 1)
    [color=blue]For[/color] rws = sr To lr [color=blue]Step[/color] 1 [color=lightgreen]'Input Array of Ranges[/color]
 
    [color=lightgreen]'Let arrOut()(rws, 1) = CapturedRangeObject.Value2()(rws - sr + 1, 1) 'Works[/color]
    [color=blue]Let[/color] vTemp = dicLookupTable.Items(rws - sr).Value2
    [color=blue]Let[/color] arrOut(rws, 1) = vTemp(rws - sr + 1, 1)
    [color=blue]Next[/color] rws
 [color=lightgreen]'End part 4)--------------------------------------[/color]
 
 [color=blue]Let[/color] RngD.Value = arrOut()
 
 [color=blue]Set[/color] dicLookupTable = [color=blue]Nothing[/color] [color=lightgreen]'Genarally good practice to turn these thimgs off.[/color]
 
[color=blue]End[/color] [color=blue]Sub[/color] [color=lightgreen]'MicrosoftScriptimeRuntimeDictionaryRangeObjectKeysItems21_27()[/color]

… have I finally got it right?

OR

….. I was thinking also that you may have been thinking along something of this form, to do away with the loop, But I could not get that to work yet

Code:
 [color=lightgreen]'3) Part 3)--transfer range objects from dictionary to array of ranges in one go,[/color]
 [color=blue]Dim[/color] rResults() [color=blue]As[/color] [color=blue]Variant[/color]
 [color=blue]Let[/color] rResults() = dicLookupTable.Items()
 [color=lightgreen]'End part 3)--- NOTE: this gives automatically the 0 to _ convention in rResults Array!.[/color]
 
 [color=lightgreen]'4) Part 4)---Produce output array by looping in VBA[/color]
 [color=blue]Dim[/color] vTemp [color=blue]As[/color] [color=blue]Variant[/color]
 
 [color=blue]Dim[/color] arrOut() [color=blue]As[/color] [color=blue]String[/color]
 [color=lightgreen]'ReDim arrOut(sr To lr, 1 To 1)[/color]
    [color=lightgreen]'For rws = sr To lr Step 1 'Input Array of Ranges[/color]
 
    [color=lightgreen]'Let arrOut()(rws, 1) = CapturedRangeObject.Value2()(rws - sr + 1, 1) 'Works[/color]
    vTemp = dicLookupTable.Items().Value2
    [color=blue]Let[/color] arrOut() = vTemp
    [color=lightgreen]'Next rws[/color]
 'End part 4)--------------------------------------


Alan
 
Upvote 0

Forum statistics

Threads
1,223,922
Messages
6,175,382
Members
452,639
Latest member
RMH2024

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top