HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Creating two dictionaries to lookup values into an array

Submitted by: @import:stackexchange-codereview··
0
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?

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 Sub


I 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. Dictionary and most of those scripting objects are (I believe) in the Microsoft Scripting Runtime library. So just add that reference and you can change

Dim 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 Dictionary


The 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 Dictionary

Context

StackExchange Code Review Q#128286, answer score: 2

Revisions (0)

No revisions yet.