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
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Hi Alan,

Your code is successfully storing the Range objects in the Dictionary. The objects are being lost in your attempt to store them in the Variant Array Results.

Try casting Results as a Range Array...

Code:
Sub ScriptingRuntimeDictionaryToStoreRangesSiHimpfGlified()
 
 Dim dicLookupTable As Scripting.Dictionary: Set dicLookupTable = New Scripting.Dictionary
 dicLookupTable.CompareMode = vbTextCompare

 Dim i As Long
 Dim sKey As String
 Dim rItem As Range
 Dim rResults() 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 rResults(1 To dicLookupTable.Count)
 '--transfer range objects from dictionary to array of ranges
 For i = 0 To dicLookupTable.Count - 1 Step 1
   Set rResults(i + 1) = dicLookupTable.Items(i)
 Next i
 
 '--confirm range objects were transfered to array of ranges
 For i = LBound(rResults) To UBound(rResults) Step 1
   With rResults(i)
      .Offset(0, 4).Value = .Address & ">" & .Row & ">" & .Value
   End With
 Next i
 
 Set dicLookupTable = Nothing
 
End Sub
 
Upvote 0
Hi Alan,

Your code is successfully storing the Range objects in the Dictionary. The objects are being lost in your attempt to store them in the Variant Array Results.

Try casting Results as a Range Array...

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



Hi Jerry,
. Many thanks for your very helpful reply. I have spent some time trying your code. I think I see where I was going wrong thanks to your code and explanation. I very much appreciate you taking the time to write that code for me.

. I am still struggling slightly as to how / why on a few points.
. If you have the time may I trouble you for a couple of follow up questions?

. ( I realize I am asking some possibly tricky questions requiring some very intimate knowledge of how VBA is working. There is no rush and I am grateful if you can reply only if and when you have the time.)


. 1) Watch Window results for my Object “dicLookupTable”
. One thing that threw me off is that in the Watch Window my “dicLookupTable” is shown as a collection of 7 String items with values equal to the string value of the cell. Can you explain this – is it just a case of some things not being shown completely in the watch window? (BTW I looked recently at some very large complicated Web Page Objects I had created and despite them having a horrendous amount of info in, all was able to be seen in the Watch Window(all be-it not all at the same time!!!) )
.
. 2) “Set” for my Results Array entries.
. In formulating and experimenting for this question to you I may have the answer and so a simple Yes may be all that is needed.
………………….
. I am always very careful to chose appropriately Let or Set depending on whether I am dealing with Objects( such as Ranges) or Values. Stupidly I overlooked in this case that the individual Results() Array elements are to be of type Range Object and that therefore the Set is required.
. So I note now that when I include the Set I do indeed now have an Array of Ranges in my Results() Array.
. But my new problem:.. I note that I achieve the required Array Of Ranges Objects within my Results() Array with both defining My Results() Array as Range or Variant. - I would typically dimension such an Array as Range if I was then setting it to a Range Object directly through
= Range(….
.- But I would have specifically used Variant here and would have expected the Dimensioning as Range should fail. My reasoning there is that in the assigning of individual Results() Array elements in this code, the code sees the my Object dicLookupTable from which a Range is obtained through the property .Items(i) .
. Something following this reasoning is certainly the case with assigning an Array of string variables through something like

Let StrArray() = Range(“A21:A27”).Value

Here dimensioning StrArray as String would fail and Dimensioning as variant is required…

. Now my attempted explanation:

. I have seen that if I loop through assigning each of my Array elements individually with something of the form

Code:
    [color=darkblue]For[/color] TableClm = 1 [color=darkblue]To[/color] LastClmTable [color=darkblue]Step[/color] 1
       [color=darkblue]For[/color] TableRow = 1 [color=darkblue]To[/color] LastRowTable
       [color=darkblue]Let[/color] StrArray(TableRow, TableClm) = Cells(TableRow, TableClm).Value
       [color=darkblue]Next[/color] TableRow
    [color=darkblue]Next[/color] TableClm


Then here it will work with both Dimensionind StrArray as String or Variant. Similarly the case for your code Dimensioning rResults() as Range or Variant

. Then it would appear that VBA is tolerant in such a looping case of seeing the Cells Object when expecting a String.

. 2a) So it is just some Peculiarity of how VBA is working that it “guesses” it right in one case but errors in the other. That is to say it is a case of it having different “Implicit defaults” in the two cases?

. 2b) Based on my 2a). It might be wise to always assign an Array for Range Objects or Strings as Variant so as to not rely on this strange “Tolerance”. And the deciding factor in obtaining the correct Type of Array relies on the correct choice of Set or Let?

. 3) As I commented in post #1, my final Code, Part 4 will not give me, that is to say, will not re insert the Range Objects in to my the spreadsheet. I expect it is not possible in the case of Ranges to do a neat “one-liner” to Output the entire Range of Ranges held within an Array of ranges, as can be done with values?

. So I would need to do something as I have indicated in orange and red in a version of your Code:
(Preferably the red to ensure that VBA guesses the correct version from the Clipboard which includes all the full Range Info)
. Can you confirm this, that is to say there is no way, other than looping to output the entire Range as range Objects for the case of a Ranges held within an Array?

A Modified version of your Code:

Code:
[color=darkblue]Sub[/color] ScriptingRuntimeDictionaryToStoreRangesJerrySullivan()
 
 [color=darkblue]Dim[/color] dicLookupTable [color=darkblue]As[/color] Scripting.Dictionary: [color=darkblue]Set[/color] dicLookupTable = [color=darkblue]New[/color] Scripting.Dictionary
 dicLookupTable.CompareMode = vbTextCompare
 
 [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
 [color=darkblue]Dim[/color] sKey [color=darkblue]As[/color] [color=darkblue]String[/color]
 [color=darkblue]Dim[/color] rItem [color=darkblue]As[/color] Range
 [color=darkblue]Dim[/color] rResults() [color=purple]As Variant' See Question 2) Post #3[/color]
 
  [color=darkblue]For[/color] i = 21 [color=darkblue]To[/color] Cells(Rows.Count, 1).End(xlUp).Row [color=darkblue]Step[/color] 1
    [color=darkblue]If[/color] Cells(i, 1).Value <> "" [color=darkblue]Then[/color]
    sKey = Cells(i, 1).Value
         [color=darkblue]If[/color] [color=darkblue]Not[/color] dicLookupTable.Exists(sKey) [color=darkblue]Then[/color]
            [color=darkblue]Let[/color] dicLookupTable(sKey) = sKey
            [color=darkblue]Set[/color] rItem = Cells(i, 1)
            [color=darkblue]Set[/color] dicLookupTable.Item(sKey) = rItem
         [color=darkblue]End[/color] [color=darkblue]If[/color]
     [color=darkblue]End[/color] [color=darkblue]If[/color]
  [color=darkblue]Next[/color] i
 
 [color=darkblue]ReDim[/color] rResults(1 [color=darkblue]To[/color] dicLookupTable.Count)
 [color=green]'--transfer range objects from dictionary to array of ranges[/color]
 [color=darkblue]For[/color] i = 0 [color=darkblue]To[/color] dicLookupTable.Count - 1 [color=darkblue]Step[/color] 1
   [color=darkblue]Set[/color] rResults(i + 1) = dicLookupTable.Items(i)
 [color=darkblue]Next[/color] i
 
 [color=green]'--confirm range objects were transfered to array of ranges[/color]
 [color=darkblue]For[/color] i = [color=darkblue]LBound[/color](rResults) [color=darkblue]To[/color] [color=darkblue]UBound[/color](rResults) [color=darkblue]Step[/color] 1
                    [color=green]'   With rResults(i)[/color]
                    [color=green]'      .Offset(0, 4).Value = .Address & ">" & .Row & ">" & .Value & ">" & .Hyperlinks(1).Address[/color]
                    [color=green]'[/color]
                    '   End With
   [color=orange]rResults(i).Copy Destination:=Range("E" & i + 20 & "")[/color]
  
   [color=red]rResults(i).Copy
   Range("E" & i + 20 & "").Select
   Selection.PasteSpecial Paste:=xlPasteFormulas
 [color=darkblue]Next[/color] i[/color]
 
 [color=darkblue]Set[/color] dicLookupTable = [color=darkblue]Nothing[/color]
 
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'ScriptingRuntimeDictionaryToStoreRangesJerrySullivan()[/color]


Many Thanks
Alan.

P.s. Thanks for the memory jog to include
Set dicLookupTable = Nothing
Which I stupidly forgot in my codes!!!
 
Upvote 0
To answer a few questions:
1. When you look at the dictionary object in the Locals window, you are actually looking at the keys, not the values - that's why you see strings.
2. Regarding array types, there are a few different things here:

Range("A1") <> Range("A1").Value
Clearly one of these is a Range Object, the other a Variant. However The default property of the Range object is "Value" so accessing the range will return the value, not the object. This behaviour is overridden with the use of "Set", consider:
Code:
    Dim ValueArray As Variant
    Dim RangeObject As Range
    
    ValueArray = Range("a1:a5") 'Variant - implicit Value
    Set RangeObject = Range("a1:a5") 'Range Object

Implicit Conversion
VBA will implicitly convert types, it does this often without you realising it, consider that in the below Chr() returns a variant, not a string:
Code:
    Dim myString As String
    myString = Chr(2)

The reason therefore that you can declare rResults() as Range is because what is actually happening is something like this (pseudocode):
Code:
   Set rResults(i + 1) = cRange(dicLookupTable.items()(i))
We can also combine the two principles above:
Code:
    Dim sKey As String

    ....

   rResults(i + 1) = dicLookupTable.items()(i) 'Removed set, access default Value property of Range

3. No, you can't do this in a neat one liner - FWIW you would probably never store ranges, rather their values. One should interact with the worksheet as little as possible as it is extremely slow.

I'd probably have written your code like this (just in case you want another angle)
Code:
Sub ScriptingRuntimeDictionary() 
 Dim dicLookupTable As Object: Set dicLookupTable = CreateObject("scripting.dictionary")
 dicLookupTable.CompareMode = vbTextCompare
 
 Dim i As Long
 Dim rResults As Variant
 
  For i = 21 To Cells(Rows.Count, 1).End(xlUp).Row Step 1
    If Cells(i, 1).Value <> "" Then
         If Not dicLookupTable.Exists(Cells(i, 1).Value) Then
            dicLookupTable.Add Cells(i, 1), Cells(i, 1)
         End If
     End If
  Next i
 
 
 rResults = dicLookupTable.items()




End Sub

P.S Note that I've also removed the Set dicLookupTable = Nothing since it's superfluous in this instance
 
Upvote 0
Hi Kyle123.
. Many thanks for your input here
. I have reviewed your input and will definitely do so again many times!.
. Clearly you know exactly wot and how VBA is working. Because of this you can confidently rely on the implicit defaults. I now know a few more of them now thanks to your input!

To answer a few questions:……………………..

I'd probably have written your code like this (just in case you want another angle)
………………….

. I am definitely interested in your angle as You have clearly explained your reasoning behind it. Thanks for taking the time.
. I am still wary of always taking any code as it is, as I have learnt to my great pain wot can happen when relying on the Implicit defaults or the “correct guess” goes wrong!
. So I still must over do a bit my Dimensioning until I gain more experience. To that end your input was very welcome.
Alan
 
Upvote 0
On the whole you're right to not trust implicit/default properties - you should always be explicit :)

I didn't perhaps explain my preference for adding dictionary items this way:
Code:
           dicLookupTable.Add Cells(i, 1), Cells(i, 1)

As opposed to:
Code:
            Let dicLookupTable(sKey) = sKey
            Set rItem = Cells(i, 1)
            Set dicLookupTable.Item(sKey) = rItem

It's purely because I find it much easier to understand as well as explicit - I like to keep it simple, I'm easily confused ;)

P.S how do you get that nice colourful syntax highlighting on your code?
 
Upvote 0
Hi Kyle,

. Thanks very much again for a bit more advice and input.


.........

P.S how do you get that nice colourful syntax highlighting on your code?



. I struggled with that for 6 months and asked a lot… Then Peter_ss finally let me in to the “secret”


. So I do not get nagged at by a “Mod” for hijacking the Thread I have just done a test for you in the Test Forum “Test for Kyle” that explains how to do this

Note I use in my settings
Enhanced Interface - Full WYSIWYG Editing
which may be important for You to see everything as I do..

Alan
 
Upvote 0
…. Further ramblings of a Computer idiot …….
.. Just feeding back to this Thread with: a code that may be useful to someone; some observations and possibly Some follow up questions. I welcome any comments….( or deserved insults to my (lack of ) intelligence / computer knowledge)

. 1 ) Watch Window results for my Object “dicLookupTable”

. Kyle explainedWhen you look at the dictionary object in the Locals window, you are actually looking at the keys“. So It is simply a peculiarity of VBA that for a Microsoft Scripting Runtime Dictionary Object only it’s Key is shown (as well as the number of items, er key items in this case?!?) rather than the complete Object including the items. Edit -- IN FACT on my new code below the MSRDOs (Microsoft Scripting Runtime Dictionary Objects) in the Locals window are actually Fully shown as Objects. Possibly again just the peculiarity that it is VBA does it differently in this case – my experiments suggest initially that the slightly different Method used by me now to assign both the keys and items in one line is responsible for this changed VBA behavior ( I am Using the Microsoft Scripting Runtime Dictionary .Add , method now)

. 2a) Kyle explained that sometimes VBA just works such that it does a conversion initially and this explained why in my case I was puzzled by being able to Dimension Something as a Range rather than me having to dimension as a Variant to allow for an Object being presented from which a Range would be returned: In the particular case I was looking at, VBA was doing a conversion to range operation and so was happy to have a dimension as range on the LHS of that particular equation despite it appearing to me that it was seeing an object. I simply did not have the knowledge once again of exactly how VBA was working.

. 2b or? ) I note that in Kyle’s code he added an extra line to Put the entire Microsoft Scripting Runtime Dictionary Object items (which as Jerry pointed out were indeed successfully a collection of Range Objects) into an Array …
rResults = dicLookupTable.items()
. I have confirmed in the watch window that this gives me a Range of Range Objects. Furthermore I have seen that VBA will not tolerate rResults dimensioned as an Array.
.
. Sort of “ 2b) or not 2b) or 3) “. (As Shakespeare said? ) VBA will not tolerate
Set rResults = dicLookupTable.items()
.
. But it does tolerate this…
Let rResults = dicLookupTable.Items()
… but still returns an Array of Range Objects!?!? Seems to be something weird going on in a “one liner” which sets um er maybe not sets? Er um .. puts it against a collection of things. But I am not quite sure wot I mean yet? ????
.
. 3) . I thought Kyle’s
rResults = dicLookupTable.items()
. which is a one liner might get me closer to outputting the Array of Ranges in my Spreadsheet in a one liner.. but something like this fails..
rResults.Copy Destination:= ……
. – I suppose as results() is an Array (all be it an Array of Ranges) but it needs to be a (Range) Object for the One liner bit to work ? Strangely using this method in a loop with something of the form
rResults(i).Copy Destination:= ….
Does work. Explanation I guess is that the Array Element , rResults(i), is an Range and I note by stepping through the program with F8 the cell referenced by rResults(i) is actually selected rather than the Array element. Bit of luck here with the implicit perhaps?!....

. _______________________________________________

. Anyways…

. I have a version now that thanks to wot I have learnt from this thread I am reasonably happy with. I have tried to generalize it a bit, in case it may be useful for anyone stumbling over the Thread and maybe looking for a start point with “Using Microsoft Scripting Runtime Dictionary to Store and then Retrieve Range Objects”.
.
….. Some “User notes”
. (i) It places a (in this case extended general case 2 dimensional) Range of Range Objects into a Microsoft Scripting Runtime dictionary

. (ii) I choose the convention of going along the rows and then down the columns as this will give Dictionary item numbers (or “index”) that follow a similar convention to the spreadsheet convention for cells (The Cells property will accept one or two arguments. When using only one argument, it must be a number which is an index or “item number” from right to left then top to bottom. (Note I loop as typical to bring the Range Objects into the Microsoft Scripting Runtime as it’s items. But have learnt here that I may then after doing this use a strange Let allowed syntax one liner to transfer these Range objects into an Array. There may be some speed advantages of this, but it is important to note that that as Array is a 1 dimensional “Row of columns” and this along with the convention for filling here must be noted in any outputting / retrieving from the Array of Range Objects.

. (iii) To apply to a general range one must simply change the bit in Purple
to a cell anywhere within the range of interest. (As well as the sheet reference)

(. (iv) At the end of the program the demonstrations again given zb. From jerry of outputting to an Offset Range to confirm Range Objects were Transferred to array of ranges ).

(. (v) A check is made and appropriate action to warn of empty cells, but the use of the unique Microsoft Scripting Runtime Dictionary for checking for identical cell contents falls down, as the Dictionary item is a Range which in this case will always be unique as it is a different Cell (Range Object) each time. – But I am still a bit puzzled as to why I could not get this bit too work..).. )


. __________________________________________________

. As always any further input is other people’s angles are always welcome and helpful. For now I have a greatly improved understanding. (Just struggle a bit between on the one side, using (at least at “first glance!”) implicit along with more explain and justifying ‘green code comments, or on the other side being very explicit with then having many unnecessary or superfluous code bits. )
.
. Thanks again Kyle and Jerry..

Alan

_________________________________________________________


Full Code.


Code:
[color=darkblue]Sub[/color] ScriptingRuntimeDictionaryToStoreRangesJerryKyleAlan()
 
[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] Rcell [color=darkblue]As[/color] Range: [color=darkblue]Set[/color] Rcell = wksLkUp.Range("A21") [color=green]'Any cell in required Range[/color]
[color=green]'[color=purple]##### Change Sheet Reference and reference Cell[/color] above to suit your Range[/color]
 
[color=green]'1a) Part 1a. The initial "Creating" One Range Object to include all cells of interest mainly to get grid size info[/color]
[color=darkblue]Dim[/color] ObjectCapturedRange [color=darkblue]As[/color] Range [color=green]'This will be set to One Range Object. Only a Range object is seen so item types can be defined as Range Objects[/color]
[color=darkblue]Set[/color] ObjectCapturedRange = Rcell.CurrentRegion [color=green]'Typical way to capture the Range in one go. Captured Range will be a grid which Inlcudes any cells "connected" to A1. SO IMPORTANT: Keep periphery of required range free. Alternative UsedRange would make a grid catching / Capturing any cell EVER used.[/color]
[color=darkblue]Dim[/color] OutputTableRow [color=darkblue]As[/color] [color=darkblue]Long[/color], OutputTableColumn [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'Bound Loop Count Variables for Output Table..  ......  http://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html[/color]
 
[color=darkblue]Dim[/color] StartRowTableOutput [color=darkblue]As[/color] Long: [color=darkblue]Let[/color] StartRowTableOutput = Rcell.Row [color=green]'We wish to loop below through items in the Range Capture. For conveniebce use the Row and Column property of our user given[/color]
[color=darkblue]Dim[/color] StartColumnTableOutput [color=darkblue]As[/color] Long: [color=darkblue]Let[/color] StartColumnTableOutput = Rcell.Column [color=green]'Reference cell to obtain Start Rows and start Columns.[/color]
[color=darkblue]Dim[/color] LastRowTableOutput [color=darkblue]As[/color] Long: [color=darkblue]Let[/color] LastRowTableOutput = StartRowTableOutput + ObjectCapturedRange.Rows.Count - 1 [color=green]'Simaly the last cell in looping can for convenience be obtained once we have the grid size (Row..[/color]
[color=darkblue]Dim[/color] LastColumnTableOutput [color=darkblue]As[/color] Long: [color=darkblue]Let[/color] LastColumnTableOutput = StartColumnTableOutput + ObjectCapturedRange.Columns.Count - 1 [color=green]'...and column Couct) obtained from those Properties of a single "Capture" Range Object[/color]
[color=green]'End part 1a. Info obtained for Spreadsheet range sizes--------------------------------------------------------[/color]
 
[color=green]' 1b)  'Part 1b: 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]'--requires library 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=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=green]'End of Part 1b initial set up Of Scripting Runtime------------------------[/color]
 
 [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color], j [color=darkblue]As[/color] Long  [color=green]'LoopBoundVariableCounts used in looping here and at end-----[/color]
 [color=darkblue]Dim[/color] TempCell [color=darkblue]As[/color] Range: [color=darkblue]Set[/color] TempCell = wksLkUp.Cells(1, Columns.Count): [color=darkblue]Dim[/color] TempCellOffset [color=darkblue]As[/color] Long: [color=darkblue]Let[/color] TempCellOffset = 0 [color=green]'We choose a cell (or through the later use of the offset a column) to use for Duplicate or Empty cells. We use the last column in the sheet. (This is genarally a good practice as it will not effect[/color]
 [color=green]'2a) Part2a) Looping to put Range Objects in MRSD[/color]
    [color=darkblue]For[/color] i = StartColumnTableOutput [color=darkblue]To[/color] LastColumnTableOutput [color=darkblue]Step[/color] 1
        [color=darkblue]For[/color] j = StartRowTableOutput [color=darkblue]To[/color] LastRowTableOutput [color=darkblue]Step[/color] 1
          [color=darkblue]If[/color] wksLkUp.Cells(j, i).Value <> "" [color=darkblue]Then[/color] [color=green]'If cell is not empty then...[/color]
               [color=darkblue]If[/color] [color=darkblue]Not[/color] dicLookupTable.Exists(Cells(j, i)) [color=darkblue]Then[/color] [color=green]'check that the unique value does not already exist. ##NOTE[/color]
                  dicLookupTable.Add wksLkUp.Cells(j, i), wksLkUp.Cells(j, i) [color=green]'it is easier to understand as well as kind of explicit the first argument does a CStr and the Second Takes anything[/color]
               [color=darkblue]Else[/color] [color=green]'I have a feeling it will allways be unique here as we are dealing with Range objects and not there values, ##[/color]
               [color=darkblue]End[/color] [color=darkblue]If[/color]
           [color=darkblue]Else[/color] [color=green]'Case fo an empty cell - inform of empty cell by writing message in that cell via the Tempory cell[/color]
           [color=darkblue]Let[/color] TempCellOffset = TempCellOffset + 1 [color=green]'Go to next free tempory cell in tempory column[/color]
           [color=darkblue]Let[/color] TempCell.Offset(TempCellOffset, 0).Value = "Leer Cell at   " & j & " | " & i & ""
          
           dicLookupTable.Add TempCell.Offset(TempCellOffset, 0), TempCell.Offset(TempCellOffset, 0)
           [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] j
    [color=darkblue]Next[/color] i
[color=green]'End Part 2[/color]
 
 '3) Part 3)--transfer range objects from dictionary to array of ranges in one go!!
 [color=darkblue]Dim[/color] rResults() [color=darkblue]As[/color] [color=darkblue]Variant[/color] [color=green]' See Question 2) Post #3 and then Further Question 2) Posts #4 and #5 and ?  http://www.mrexcel.com/forum/excel-questions/832103-using-microsoft-scripting-runtime-dictionary-store-then-retrieve-range-objects.html?#post4059199[/color]
 [color=darkblue]Let[/color] rResults = dicLookupTable.Items() [color=green]'Note this gives automatically the 0 to ..   convention in rResults Array![/color]
 [color=green]'End part 3)[/color]
 
 '--confirm range objects were transfered to array of ranges with various methods
 [color=darkblue]Dim[/color] MSRDindex [color=darkblue]As[/color] Long: [color=darkblue]Let[/color] MSRDindex = 0 [color=green]'LoopBoundVariableCounts for Item number of MSRD[/color]
    [color=darkblue]For[/color] i = StartColumnTableOutput [color=darkblue]To[/color] LastColumnTableOutput [color=darkblue]Step[/color] 1
        [color=darkblue]For[/color] j = StartRowTableOutput [color=darkblue]To[/color] LastRowTableOutput [color=darkblue]Step[/color] 1
             [color=darkblue]Let[/color] MSRDindex = MSRDindex + 1 [color=green]'Next item numbe from MSRD[/color]
[color=green]'                    With rResults(MSRDindex - 1) 'Jerry Sullivan Demo for example entire range full with Hyperlinks[/color]
[color=green]'                       wksLkUp.Cells(j, i).Offset(0, 4).Value = .Address & ">" & .Row & ">" & .Value & ">" & .Hyperlinks(1).Address[/color]
[color=green]'                    End With[/color]
[color=green]'             rResults(MSRDindex - 1).Copy Destination:=wksLkUp.Cells(j, i).Offset(0, 4) '[/color]
[color=green]'[/color]
             rResults(MSRDindex - 1).Copy
             wksLkUp.Cells(j, i).Offset(0, 4).Select [color=green]'These 2 lines may be better Preferably to ensure that VBA...[/color]
             Selection.PasteSpecial Paste:= xlPasteAllUsingSourceTheme [color=green]'.....guesses the correct version from the Clipboard which includes all the full Range Info.   Post #6 here -  http://www.mrexcel.com/forum/excel-questions/828241-visual-basic-applications-autofilter-specialcells-xlcelltypevisible-copy-only-values-not-formulas.html[/color]
        [color=darkblue]Next[/color] j
    [color=darkblue]Next[/color] i
 
 [color=darkblue]Set[/color] dicLookupTable = [color=darkblue]Nothing[/color] [color=green]'Generally good practice to turn these things off. 'May not be needed but to keep program flexible should alterations need it.[/color]
 
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'ScriptingRuntimeDictionaryToStoreRangesJerryKyleAlan()[/color]


.. in this example working on this Spreadsheet:


[Table="class: grid"][tr][td] [/td][td]
A
[/td][td]
B
[/td][/tr]
[tr][td]
21
[/td][td]
Apple fresh​
[/td][td]
Apfel​
[/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]
"Peperonata" Paprikazubereitung Vogeley GV​
[/td][/tr]

[tr][td]
24
[/td][td]
'Gaisburger Marsch' (potatoes with beef) (1)​
[/td][td]
"Pomona" Tomtenpüree-Konzentrat Vogeley GV​
[/td][/tr]

[tr][td]
25
[/td][td]
Beef cooked​
[/td][td]
Biene-Maja' Banane-Mandel Fruchtschnitte, Evers Naturkost​
[/td][/tr]

[tr][td]
26
[/td][td]
'Heaven and earth' (apples and pot.) with blood sausage (3)​
[/td][td]
'Flip' Apfel-Birne Fruchtschnitte, Evers Naturkost​
[/td][/tr]

[tr][td]
27
[/td][td]
'Jägersoße' (thickened brown sauce with mushrooms) (5)​
[/td][td]
'Maja-Willi-Flip' Multifrucht Fruchtschnitte, Evers Naturkost​
[/td][/tr]

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


…..

… gives these results…


[Table="class: grid"][tr][td] [/td][td]
E
[/td][td]
F
[/td][/tr]
[tr][td]
21
[/td][td]
Apple fresh​
[/td][td]
Apfel​
[/td][/tr]

[tr][td]
22
[/td][td]
'Bierwurst' (coarse heat-treated sausage in bladder and smo​
[/td][td]
Leer Cell at 22 | 2​
[/td][/tr]

[tr][td]
23
[/td][td]
'Breslauer' Lyonaise​
[/td][td]
"Peperonata" Paprikazubereitung Vogeley GV​
[/td][/tr]

[tr][td]
24
[/td][td]
'Gaisburger Marsch' (potatoes with beef) (1)​
[/td][td]
"Pomona" Tomtenpüree-Konzentrat Vogeley GV​
[/td][/tr]

[tr][td]
25
[/td][td]
Beef cooked​
[/td][td]
Biene-Maja' Banane-Mandel Fruchtschnitte, Evers Naturkost​
[/td][/tr]

[tr][td]
26
[/td][td]
'Heaven and earth' (apples and pot.) with blood sausage (3)​
[/td][td]
'Flip' Apfel-Birne Fruchtschnitte, Evers Naturkost​
[/td][/tr]

[tr][td]
27
[/td][td]
'Jägersoße' (thickened brown sauce with mushrooms) (5)​
[/td][td]
'Maja-Willi-Flip' Multifrucht Fruchtschnitte, Evers Naturkost​
[/td][/tr]

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



(In the actual Worksheet supplied at the end of this Thread it can be confirmed that Range Objects are copied)
………..____________

The code again without Comments:






Code:
Sub ScriptingRuntimeDictionaryToStoreRangesJerryKyleAlanNoComments()
 
Dim wksLkUp As Worksheet: Set wksLkUp = ThisWorkbook.Worksheets("debiNetEnglish")
Dim Rcell As Range: Set Rcell = wksLkUp.Range("A21")
 
Dim ObjectCapturedRange As Range
Set ObjectCapturedRange = Rcell.CurrentRegion
Dim OutputTableRow As Long, OutputTableColumn As Long
 
Dim StartRowTableOutput As Long: Let StartRowTableOutput = Rcell.Row
Dim StartColumnTableOutput As Long: Let StartColumnTableOutput = Rcell.Column
Dim LastRowTableOutput As Long: Let LastRowTableOutput = StartRowTableOutput + ObjectCapturedRange.Rows.Count - 1
Dim LastColumnTableOutput As Long: Let LastColumnTableOutput = StartColumnTableOutput + ObjectCapturedRange.Columns.Count - 1
 
 
 Dim dicLookupTable As Scripting.Dictionary
 Set dicLookupTable = New Scripting.Dictionary
 
     dicLookupTable.CompareMode = vbTextCompare
 
 Dim i As Long, j As Long
 Dim TempCell As Range: Set TempCell = wksLkUp.Cells(1, Columns.Count): Dim TempCellOffset As Long: Let TempCellOffset = 0
 
    For i = StartColumnTableOutput To LastColumnTableOutput Step 1
        For j = StartRowTableOutput To LastRowTableOutput Step 1
          If wksLkUp.Cells(j, i).Value <> "" Then
               If Not dicLookupTable.Exists(Cells(j, i)) Then
                  dicLookupTable.Add wksLkUp.Cells(j, i), wksLkUp.Cells(j, i)
               Else
               End If
           Else
           Let TempCellOffset = TempCellOffset + 1
           Let TempCell.Offset(TempCellOffset, 0).Value = "Leer Cell at   " & j & " | " & i & ""
          
           dicLookupTable.Add TempCell.Offset(TempCellOffset, 0), TempCell.Offset(TempCellOffset, 0)
           End If
        Next j
    Next i
 
 Dim rResults() As Variant
 Let rResults = dicLookupTable.Items()
 
 Dim MSRDindex As Long: Let MSRDindex = 0
    For i = StartColumnTableOutput To LastColumnTableOutput Step 1
        For j = StartRowTableOutput To LastRowTableOutput Step 1
             Let MSRDindex = MSRDindex + 1
 
             rResults(MSRDindex - 1).Copy
             wksLkUp.Cells(j, i).Offset(0, 4).Select
             Selection.PasteSpecial Paste:= xlPasteAllUsingSourceTheme
        Next j
    Next i
 
 Set dicLookupTable = Nothing
 
End Sub

File (XL 2007 “PEListScriptingRuntime2.xlsm” Macros in Module “MrExcelScrip_****”
https://app.box.com/s/lkv8qe7ju2juxxov9cxn0lrm3krnn839







---_____________________________________
 
Upvote 0
Just to clarify:
IN FACT on my new code below the MSRDOs (Microsoft Scripting Runtime Dictionary Objects) in the Locals window are actually Fully shown as Objects
Actually they aren't again you're just looking at the keys. It's just in this case you are using Range objects as Keys (in a dictionary keys need not be strings - I think they can be anything expect Arrays).

Consider the following:
Rich (BB code):
    For i = StartColumnTableOutput To LastColumnTableOutput Step 1
        For j = StartRowTableOutput To LastRowTableOutput Step 1
          If wksLkUp.Cells(j, i).Value <> "" Then
               If Not dicLookupTable.Exists(Cells(j, i)) Then
                  dicLookupTable.Add wksLkUp.Cells(j, i).Value, wksLkUp.Cells(j, i)
               Else
               End If
           Else
           Let TempCellOffset = TempCellOffset + 1
           Let TempCell.Offset(TempCellOffset, 0).Value = "Leer Cell at   " & j & " | " & i & ""
          
           dicLookupTable.Add TempCell.Offset(TempCellOffset, 0).Value, TempCell.Offset(TempCellOffset, 0)
           End If
        Next j
    Next i

Since we are explicitly setting the keys to strings - you will now see only strings again. You could in fact accomplish the task using only keys and not items:
Rich (BB code):
    For i = StartColumnTableOutput To LastColumnTableOutput Step 1
        For j = StartRowTableOutput To LastRowTableOutput Step 1
          If wksLkUp.Cells(j, i).Value <> "" Then
               If Not dicLookupTable.Exists(Cells(j, i)) Then
                  dicLookupTable.Add wksLkUp.Cells(j, i), Nothing
               Else
               End If
           Else
           Let TempCellOffset = TempCellOffset + 1
           Let TempCell.Offset(TempCellOffset, 0).Value = "Leer Cell at   " & j & " | " & i & ""
          
           dicLookupTable.Add TempCell.Offset(TempCellOffset, 0), Nothing
           End If
        Next j
    Next i
    '-----------------------------------------
    Let rResults = dicLookupTable.Keys()

You are quite correct in your assumption that you cannot use the "one-liner" to write the cells back to the sheets since the Keys()/Items() operators return a Variant array which is not an object so does not have a Copy() method, you must access each Range object to access its Copy method
 
Upvote 0
Hi Kyle, …..:pray: :pray:

. I was not expecting a reply to my somewot rambling Post.
. Your detailed reply was extremely helpful. In fact it informed me of new things , cleared up others and explained away many things that had been giving me problems.

. 1) Something new first before I comment on the main Points of your reply. I note the first code you gave did not work for me giving an error at this line
.
dicLookupTable.Add wksLkUp.Cells(j, i).Value, wksLkUp.Cells(j, i)
.
. the error says something (in my German Excel) which roughly translates to saying in English that the key has already been given to an item in the List. However, further “F8 stepping through” investigation showed that the error occurred if I hit a cell with a Duplicate value.
. The following modification then works

If Not dicLookupTable.Exists(Cells(j, i).Value) Then
dicLookupTable.Add Cells(j, i).Value, wksLkUp.Cells(j, i)

. I think this makes sense – the .Exist bit was looking for a key equal to a Range Object with Exists(Cells(j, i).) and not a string equal to the cell value. So the check for the unique value was falling down, not catching then the Duplicate resulting in an error in the next line when it tried to assign a second time the key.
.. so that confirms again the crux of wot you were saying in the reply and the main thing I was doing wrong which had been causing most of my problems…

. 2a) I was being thrown off at many points as I had stupidly miss read ( or rather done some stupid “assuming” – and as the saying goes .. “when I ***-u-me , I make an **** out of U and Me” ) from some of your post #4 and #6 that this
dicLookupTable.Add Cells(i, 1), Cells(i, 1)
was converting the first argument, the key, to a String. It does not. And you did not say it did. My stupid mistake / assumption

. 2b) Looking back I see I have read articles that say that the keys can be almost anything. It just did not twig - I bet a lot of people miss that gem of info (It is certainly a crazy concept if you think about it….Like saying in a Filing Cabinet I have a piece of paper for every House in a town with all the plans and details of the house in it. The parallel idea to the Keys being able to be almost anything would be that instead of the piece of paper I could a Duplicate of every House in the filing cabinet!!! ).
. Many thanks for giving another code taking advantage of this strange concept. That certainly helps me to get started on a few new ideas and (crazy) thoughts

. 2c) having got the above bits straight I was additionally able to see where I was going wrong in trying to get my code to pick out and identify Duplicates.. Again I had not grasped that my key was a Range Object. (It has also saved my computer which crashed badly a few times as I tried to do a Debug.Print on a Range Objects which I had mistakenly thought were Strings!!).
. So I can feed back to this Thread now and give a final code below which will also identify duplicates
(For this Range object example I stay with Keys and items as I cannot take advantage of the unique check bit here if I just use Keys as the keys would then always be unique as each key would be a different cell and so even if everything else about it was the same, it will have a unique address)



. 3) Thanks again for confirming that my one liner idea for an output will not work, and particularly thanks for explain exactly and clearly why “since the Keys()/Items() operators return a Variant array which is not an object so does not have a Copy() method, you must access each Range object to access its Copy method”

. 4) my last worry about Let working in the one liner
Let anArray = AnObjectOrWoteverEvenARange
Or
Let anArray() = AnObjectOrWoteverEvenARange
. .. I think I get now… this is simply VBA syntax for filling an array with a collection

. I am beginning to get a very good understanding now of how VBA is working on some aspects of MSRDOs thanks to your detailed replies.
Many thanks again.

Alan

. ______________________________

Code:


Code:
[COLOR=lightgreen]'[/COLOR]
[COLOR=deepskyblue]Sub[/COLOR] ScriptingRuntimeDictionaryToStoreRangesKyle2() 'http://www.mrexcel.com/forum/excel-questions/832103-using-microsoft-scripting-runtime-dictionary-store-then-retrieve-range-objects.html?#post4062236
 
[COLOR=deepskyblue]Dim[/COLOR] wksLkUp [COLOR=deepskyblue]As[/COLOR] Worksheet: [COLOR=deepskyblue]Set[/COLOR] wksLkUp = ThisWorkbook.Worksheets("debiNetEnglish") [COLOR=lightgreen]'Give Abbreviation methods and properties of Object Worksheets (Intellisense then gives suggestions through use of . Dot[/COLOR]
[COLOR=deepskyblue]Dim[/COLOR] rcell [COLOR=deepskyblue]As[/COLOR] Range: [COLOR=deepskyblue]Set[/COLOR] rcell = wksLkUp.Range("A21") [COLOR=lightgreen]'Any cell in required Range[/COLOR]
[COLOR=lightgreen]'##### [COLOR=purple]Change Sheet Reference and reference Cell[/COLOR] above to suit your Range[/COLOR]
 
[COLOR=lightgreen]'1a) Part 1a. The initial "Creating" One Range Object to include all cells of interest mainly to get grid size info[/COLOR]
[COLOR=deepskyblue]Dim[/COLOR] ObjectCapturedRange [COLOR=deepskyblue]As[/COLOR] Range [COLOR=lightgreen]'This will be set to One Range Object. Only a Range object is seen so item types can be defined as Range Objects[/COLOR]
[COLOR=deepskyblue]Set[/COLOR] ObjectCapturedRange = rcell.CurrentRegion [COLOR=lightgreen]'Typical way to capture the Range in one go. Captured Range will be a grid which Inlcudes any cells "connected" to A1. SO IMPORTANT: Keep periphery of required range free. Alternative UsedRange would make a grid catching / Capturing any cell EVER used.[/COLOR]
[COLOR=deepskyblue]Dim[/COLOR] OutputTableRow [COLOR=deepskyblue]As[/COLOR] [COLOR=deepskyblue]Long[/COLOR], OutputTableColumn [COLOR=deepskyblue]As[/COLOR] [COLOR=deepskyblue]Long[/COLOR] [COLOR=lightgreen]'Bound Loop Count Variables for Output Table..  ......  http://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html[/COLOR]
 
[COLOR=deepskyblue]Dim[/COLOR] StartRowTableOutput [COLOR=deepskyblue]As[/COLOR] Long: [COLOR=deepskyblue]Let[/COLOR] StartRowTableOutput = rcell.Row [COLOR=lightgreen]'We wish to loop below through items in the Range Capture. For conveniebce use the Row and Column property of our user given[/COLOR]
[COLOR=deepskyblue]Dim[/COLOR] StartColumnTableOutput [COLOR=deepskyblue]As[/COLOR] Long: [COLOR=deepskyblue]Let[/COLOR] StartColumnTableOutput = rcell.Column [COLOR=lightgreen]'Reference cell to obtain Start Rows and start Columns.[/COLOR]
[COLOR=deepskyblue]Dim[/COLOR] LastRowTableOutput [COLOR=deepskyblue]As[/COLOR] Long: [COLOR=deepskyblue]Let[/COLOR] LastRowTableOutput = StartRowTableOutput + ObjectCapturedRange.Rows.Count - 1 [COLOR=lightgreen]'Simaly the last cell in looping can for convenience be obtained once we have the grid size (Row..[/COLOR]
[COLOR=deepskyblue]Dim[/COLOR] LastColumnTableOutput [COLOR=deepskyblue]As[/COLOR] Long: [COLOR=deepskyblue]Let[/COLOR] LastColumnTableOutput = StartColumnTableOutput + ObjectCapturedRange.Columns.Count - 1 [COLOR=lightgreen]'...and column Couct) obtained from those Properties of a single "Capture" Range Object[/COLOR]
[COLOR=lightgreen]'End part 1a. Info obtained for Spreadsheet range sizes--------------------------------------------------------[/COLOR]
 
[COLOR=lightgreen]' 1b)  'Part 1b: Setting up Scriptimg Runtime Stuff-----------------------------[/COLOR]
[COLOR=lightgreen]' Attempting Using the Microsooft Scripting Runtime Dictionary to store Range Objects[/COLOR]
 
[COLOR=lightgreen]'We put the unique values now into a Dictionary for later look up purposes:[/COLOR]
[COLOR=lightgreen]'--requires library reference to MS Scripting Runtime (Early Binding)-[/COLOR]
[COLOR=lightgreen]'        Tools>>References>>scrolldown and check the box next to Microsoft Scripting Runtime[/COLOR]
[COLOR=lightgreen]'  ..Or crashes at next line.....[/COLOR]
 [COLOR=deepskyblue]Dim[/COLOR] dicLookupTable [COLOR=deepskyblue]As[/COLOR] Scripting.Dictionary [COLOR=lightgreen]'Data held with a unique "Key"or Part Number.[/COLOR]
 [COLOR=deepskyblue]Set[/COLOR] dicLookupTable = [COLOR=deepskyblue]New[/COLOR] Scripting.Dictionary
[COLOR=lightgreen]' 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=lightgreen]'        Dim dicLookupTable As Object[/COLOR]
[COLOR=lightgreen]'        Set dicLookupTable = CreateObject("Scripting.Dictionary")[/COLOR]
[COLOR=lightgreen]' Late Binding is better when sharing files as I am here. Early Binding has the advantage that Excel intellisense[/COLOR]
[COLOR=lightgreen]' 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=lightgreen]'Not quite sure wot this does yet[/COLOR]
 
[COLOR=lightgreen]'.  A Dictionary in VBA is a collection of objects :you can store all kinds of things in it.[/COLOR]
[COLOR=lightgreen]'.  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=lightgreen]'.  (Although the Dictionary has not been designed for that purpose it's a nice side effect.)[/COLOR]
 
[COLOR=lightgreen]'End of Part 1b initial set up Of Scripting Runtime------------------------[/COLOR]
 
 [COLOR=deepskyblue]Dim[/COLOR] i [COLOR=deepskyblue]As[/COLOR] [COLOR=deepskyblue]Long[/COLOR], j [COLOR=deepskyblue]As[/COLOR] Long  [COLOR=lightgreen]'LoopBoundVariableCounts used in looping here and at end-----[/COLOR]
 [COLOR=deepskyblue]Dim[/COLOR] TempCell [COLOR=deepskyblue]As[/COLOR] Range: [COLOR=deepskyblue]Set[/COLOR] TempCell = wksLkUp.Cells(1, Columns.Count): [COLOR=deepskyblue]Dim[/COLOR] TempCellOffset [COLOR=deepskyblue]As[/COLOR] Long: [COLOR=deepskyblue]Let[/COLOR] TempCellOffset = 0 [COLOR=lightgreen]'We choose a cell (or through the later use of the offset a column) to use for Duplicate or Empty cells. We use the last column in the sheet. (This is genarally a good practice as it will not effect[/COLOR]
 [COLOR=lightgreen]'2a) Part2a) Looping to put Range Objects in MRSD[/COLOR]
    [COLOR=deepskyblue]For[/COLOR] i = StartColumnTableOutput [COLOR=deepskyblue]To[/COLOR] LastColumnTableOutput [COLOR=deepskyblue]Step[/COLOR] 1
        [COLOR=deepskyblue]For[/COLOR] j = StartRowTableOutput [COLOR=deepskyblue]To[/COLOR] LastRowTableOutput [COLOR=deepskyblue]Step[/COLOR] 1
          [COLOR=deepskyblue]If[/COLOR] wksLkUp.Cells(j, i).Value <> "" [COLOR=deepskyblue]Then[/COLOR] [COLOR=lightgreen]'If cell is not empty then...[/COLOR]
               [COLOR=deepskyblue]If[/COLOR] [COLOR=deepskyblue]Not[/COLOR] dicLookupTable.Exists(wksLkUp.Cells(j, i).Value) [COLOR=deepskyblue]Then[/COLOR] [COLOR=lightgreen]'check that the unique value does not already exist. ##NOTE[/COLOR]
                  dicLookupTable.Add wksLkUp.Cells(j, i).Value, wksLkUp.Cells(j, i) [COLOR=lightgreen]'it is easier to understand as well as kind of explicit the first argument does a CStr and the Second Takes anything[/COLOR]
               [COLOR=deepskyblue]Else[/COLOR] [COLOR=lightgreen]'If the key exists, that is to say we have a Range with a Duplicate value, we give the key a slightly modified (unique value) , still give the Range Object as an item, but make an indication, here by highlighting the cell in Pink[/COLOR]
               [COLOR=deepskyblue]Let[/COLOR] TempCellOffset = TempCellOffset + 1
               [COLOR=deepskyblue]Let[/COLOR] TempCell.Offset(TempCellOffset, 0).Value = "Duplicate at   " & j & " | " & i & ""
               wksLkUp.Cells(j, i).Interior.Color = 10987519
               dicLookupTable.Add TempCell.Offset(TempCellOffset, 0).Value, wksLkUp.Cells(j, i) [COLOR=lightgreen]'In case of duplicate we need a unique key, but we stillinclude the Duplicate Range[/COLOR]
               [COLOR=deepskyblue]End[/COLOR] [COLOR=deepskyblue]If[/COLOR]
           [COLOR=deepskyblue]Else[/COLOR] [COLOR=lightgreen]'Case fo an empty cell - inform of empty cell by writing message in that cell via the Tempory cell[/COLOR]
           [COLOR=deepskyblue]Let[/COLOR] TempCellOffset = TempCellOffset + 1 [COLOR=lightgreen]'Go to next free tempory cell in tempory column[/COLOR]
           [COLOR=deepskyblue]Let[/COLOR] TempCell.Offset(TempCellOffset, 0).Value = "Empty Cell at   " & j & " | " & i & ""
           dicLookupTable.Add TempCell.Offset(TempCellOffset, 0).Value, TempCell.Offset(TempCellOffset, 0)
           [COLOR=deepskyblue]End[/COLOR] [COLOR=deepskyblue]If[/COLOR]
        [COLOR=deepskyblue]Next[/COLOR] j
    [COLOR=deepskyblue]Next[/COLOR] i
[COLOR=lightgreen]'End Part 2[/COLOR]
 
 '3) Part 3)--transfer range objects from dictionary to array of ranges in one go!!
 [COLOR=deepskyblue]Dim[/COLOR] rResults() [COLOR=deepskyblue]As[/COLOR] [COLOR=deepskyblue]Variant[/COLOR] [COLOR=lightgreen]' See Question 2) Post #3 and then Further Question 2) Posts #4 and #5 and ?  http://www.mrexcel.com/forum/excel-questions/832103-using-microsoft-scripting-runtime-dictionary-store-then-retrieve-range-objects.html?#post4059199[/COLOR]
 [COLOR=deepskyblue]Let[/COLOR] rResults() = dicLookupTable.Items() [COLOR=lightgreen]'Note this gives automatically the 0 to ..   convention in rResults Array![/COLOR]
 [COLOR=lightgreen]'End part 3)[/COLOR]
 
 '--confirm range objects were transfered to array of ranges with various methods
 [COLOR=deepskyblue]Dim[/COLOR] MSRDindex [COLOR=deepskyblue]As[/COLOR] Long: [COLOR=deepskyblue]Let[/COLOR] MSRDindex = 0 [COLOR=lightgreen]'LoopBoundVariableCounts for Item number of MSRD[/COLOR]
    [COLOR=deepskyblue]For[/COLOR] i = StartColumnTableOutput [COLOR=deepskyblue]To[/COLOR] LastColumnTableOutput [COLOR=deepskyblue]Step[/COLOR] 1
        [COLOR=deepskyblue]For[/COLOR] j = StartRowTableOutput [COLOR=deepskyblue]To[/COLOR] LastRowTableOutput [COLOR=deepskyblue]Step[/COLOR] 1
             [COLOR=deepskyblue]Let[/COLOR] MSRDindex = MSRDindex + 1 [COLOR=lightgreen]'Next item numbe from MSRD[/COLOR]
[COLOR=lightgreen]'                    With rResults(MSRDindex - 1) 'Jerry Sullivan Demo for example entire range full with Hyperlinks[/COLOR]
[COLOR=lightgreen]'                       wksLkUp.Cells(j, i).Offset(0, 4).Value = .Address & ">" & .Row & ">" & .Value & ">" & .Hyperlinks(1).Address[/COLOR]
[COLOR=lightgreen]'                    End With[/COLOR]
[COLOR=lightgreen]'             rResults(MSRDindex - 1).Copy Destination:=wksLkUp.Cells(j, i).Offset(0, 4) '[/COLOR]
[COLOR=lightgreen]'[/COLOR]
             rResults(MSRDindex - 1).Copy
             wksLkUp.Cells(j, i).Offset(0, 4).Select [COLOR=lightgreen]'These 2 lines may be better Preferably to ensure that VBA...[/COLOR]
             Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme [COLOR=lightgreen]'.....guesses the correct version from the Clipboard which includes all the full Range Info.   Post #6 here -  http://www.mrexcel.com/forum/excel-questions/828241-visual-basic-applications-autofilter-specialcells-xlcelltypevisible-copy-only-values-not-formulas.html[/COLOR]
        [COLOR=deepskyblue]Next[/COLOR] j
    [COLOR=deepskyblue]Next[/COLOR] i
 
 [COLOR=deepskyblue]Set[/COLOR] dicLookupTable = [COLOR=deepskyblue]Nothing[/COLOR] [COLOR=lightgreen]'Genarally good practice to turn these thimgs off. 'May not be needed but to keep program flexible should alterations need it.[/COLOR]
 
[COLOR=deepskyblue]End[/COLOR] [COLOR=deepskyblue]Sub[/COLOR] [COLOR=lightgreen]'ScriptingRuntimeDictionaryToStoreRangesKyle2()[/COLOR]








It will take this



Unknown[TABLE="width: 10"]
<colgroup><col width="25px" style="background-color: #E0E0F0"><col><col></colgroup><thead>[TR="bgcolor: #E0E0F0"]
[TH][/TH]
[TH]A[/TH]
[TH]B[/TH]
[/TR]
</thead><tbody>[TR]
[TD="align: center"]21[/TD]
[TD]Apple fresh[/TD]
[TD]Apfel[/TD]
[/TR]
[TR]
[TD="align: center"]22[/TD]
[TD]'Bierwurst' (coarse heat-treated sausage in bladder and smo[/TD]
[TD]Beef cooked[/TD]
[/TR]
[TR]
[TD="align: center"]23[/TD]
[TD]'Breslauer' Lyonaise[/TD]
[TD]"Peperonata" Paprikazubereitung Vogeley GV[/TD]
[/TR]
[TR]
[TD="align: center"]24[/TD]
[TD]'Gaisburger Marsch' (potatoes with beef) (1)[/TD]
[TD]"Pomona" Tomtenpüree-Konzentrat Vogeley GV[/TD]
[/TR]
[TR]
[TD="align: center"]25[/TD]
[TD]Beef cooked[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: center"]26[/TD]
[TD]'Heaven and earth' (apples and pot.) with blood sausage (3)[/TD]
[TD]'Flip' Apfel-Birne Fruchtschnitte, Evers Naturkost[/TD]
[/TR]
[TR]
[TD="align: center"]27[/TD]
[TD]'Jägersoße' (thickened brown sauce with mushrooms) (5)[/TD]
[TD]'Maja-Willi-Flip' Multifrucht Fruchtschnitte, Evers Naturkost[/TD]
[/TR]
[TR]
[TD="align: center"]28[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]
debiNetEnglish





…..


And give this


Unknown[TABLE="width: 10"]
<colgroup><col width="25px" style="background-color: #E0E0F0"><col><col></colgroup><thead>[TR="bgcolor: #E0E0F0"]
[TH][/TH]
[TH]E[/TH]
[TH]F[/TH]
[/TR]
</thead><tbody>[TR]
[TD="align: center"]21[/TD]
[TD]Apple fresh[/TD]
[TD]Apfel[/TD]
[/TR]
[TR]
[TD="align: center"]22[/TD]
[TD]'Bierwurst' (coarse heat-treated sausage in bladder and smo[/TD]
[TD="bgcolor: #FFA7A7"]Beef cooked[/TD]
[/TR]
[TR]
[TD="align: center"]23[/TD]
[TD]'Breslauer' Lyonaise[/TD]
[TD]"Peperonata" Paprikazubereitung Vogeley GV[/TD]
[/TR]
[TR]
[TD="align: center"]24[/TD]
[TD]'Gaisburger Marsch' (potatoes with beef) (1)[/TD]
[TD]"Pomona" Tomtenpüree-Konzentrat Vogeley GV[/TD]
[/TR]
[TR]
[TD="align: center"]25[/TD]
[TD]Beef cooked[/TD]
[TD]Empty Cell at 25 | 2[/TD]
[/TR]
[TR]
[TD="align: center"]26[/TD]
[TD]'Heaven and earth' (apples and pot.) with blood sausage (3)[/TD]
[TD]'Flip' Apfel-Birne Fruchtschnitte, Evers Naturkost[/TD]
[/TR]
[TR]
[TD="align: center"]27[/TD]
[TD]'Jägersoße' (thickened brown sauce with mushrooms) (5)[/TD]
[TD]'Maja-Willi-Flip' Multifrucht Fruchtschnitte, Evers Naturkost[/TD]
[/TR]
[TR]
[TD="align: center"]28[/TD]
[TD][/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]
debiNetEnglish
 
Upvote 0

Forum statistics

Threads
1,223,912
Messages
6,175,348
Members
452,638
Latest member
Oluwabukunmi

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