4
\$\begingroup\$

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 I don't need to redim.

\$\endgroup\$
1
  • 1
    \$\begingroup\$ Until somebody posts an answer, feel free to edit the code as much as you need to. \$\endgroup\$
    – Kaz
    Commented May 13, 2016 at 14:04

1 Answer 1

2
\$\begingroup\$

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!

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.