patternMinor
Creating two dictionaries to lookup values into an array
Viewed 0 times
creatingintoarraytwolookupvaluesdictionaries
Problem
In my attempt to help improve Using Array to store calculations in VBA, I figured a good way to do it would be to create two dictionaries of values to lookup.
So this was my attempt at creating two dictionaries from two sheets and then gathering data from a third sheet into an array and looking up the items in the array based on a condition as to which dictionary to use.
My sample is pretty small and the last line of printing was just to see it worked. I actually struggled with this for a little while, so I'm thinking there are some improvements to be made. Also - is this sufficiently made to be scaled up to millions of data points? What about more than one dictionary - should that be refactored? What if there are more criteria needed for the lookup?
I don't want to edit the code, but I just realized
So this was my attempt at creating two dictionaries from two sheets and then gathering data from a third sheet into an array and looking up the items in the array based on a condition as to which dictionary to use.
My sample is pretty small and the last line of printing was just to see it worked. I actually struggled with this for a little while, so I'm thinking there are some improvements to be made. Also - is this sufficiently made to be scaled up to millions of data points? What about more than one dictionary - should that be refactored? What if there are more criteria needed for the lookup?
Option Explicit
Public Sub ArrayLookupAndPopulate()
Dim firstTable As Object
Set firstTable = CreateObject("Scripting.Dictionary")
Dim secondTable As Object
Set secondTable = CreateObject("Scripting.Dictionary")
Dim rowNumber As Long
Dim myKey As String
Dim lookupArray As Variant
Dim myIndex As Long
For rowNumber = 1 To 10
firstTable.Add CStr(Sheet1.Cells(rowNumber, 1)), Sheet1.Cells(rowNumber, 3)
secondTable.Add CStr(Sheet2.Cells(rowNumber, 1)), Sheet2.Cells(rowNumber, 3)
Next
Dim lastRow As Long
lastRow = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
Dim lastColumn As Long
lastColumn = Sheet3.Cells(1, Columns.Count).End(xlToLeft).Column + 1
ReDim lookupArray(1 To lastRow, 1 To lastColumn)
lookupArray = Sheet3.Range(Cells(1, 1), Cells(lastRow, lastColumn))
For myIndex = 1 To 9
myKey = lookupArray(myIndex, 2)
If lookupArray(myIndex, 1) = "First" Then lookupArray(myIndex, 3) = firstTable.Item(myKey)
If lookupArray(myIndex, 1) = "Second" Then lookupArray(myIndex, 3) = secondTable.Item(myKey)
Next
Sheet3.Range("F1:H9") = lookupArray
End SubI don't want to edit the code, but I just realized
Solution
This is pretty sound, although I never like just creating objects. I normally import the library I want to reference right off the bat.
to:
The only other critique I would have is to split up those
Overall it's pretty solid code. Kudos!
Dictionary and most of those scripting objects are (I believe) in the Microsoft Scripting Runtime library. So just add that reference and you can changeDim firstTable As Object
Set firstTable = CreateObject("Scripting.Dictionary")
Dim secondTable As Object
Set secondTable = CreateObject("Scripting.Dictionary")to:
Dim firstTable as Dictionary
Dim secondTable as Dictionary
Set firstTable = new Dictionary
Set secondTable = new DictionaryThe only other critique I would have is to split up those
If Statements, but that's all a matter of taste in my opinion (There are some that would have gripes about the formatting of If and Then on the same line)Overall it's pretty solid code. Kudos!
Code Snippets
Dim firstTable As Object
Set firstTable = CreateObject("Scripting.Dictionary")
Dim secondTable As Object
Set secondTable = CreateObject("Scripting.Dictionary")Dim firstTable as Dictionary
Dim secondTable as Dictionary
Set firstTable = new Dictionary
Set secondTable = new DictionaryContext
StackExchange Code Review Q#128286, answer score: 2
Revisions (0)
No revisions yet.