Copy Multiple Excel Tables to VBA Dictionary

Question

I have a number of Excel tables that I want to populate into VBA dictionaries. Most of the code is repetitive but there are some unique things for each table that prevent me from making one general purpose routine and calling it for each table. The basic code:

Public Sub MakeDictionary( _
    ByVal Tbl As ListObject, _
    ByRef Dict As Scripting.Dictionary)

    ' This routine loads an Excel table into a VBA dictionary

    Dim ThisList As TableHandler
    Set ThisList = New TableHandler

    Dim Ary As Variant

    If ThisList.TryReadTable(Tbl, False, Ary) Then
        Set Dict = New Scripting.Dictionary

        pInitialized = True

        Dim I As Long
        For I = 2 To UBound(Ary, 1)
            Dim ThisClass As MyClass
            Set ThisClass = New MyClass

            ThisClass.Field1 = Ary(I, 1)
            ThisClass.Field2 = Ary(I, 2)

            If Dict.Exists(Ary(I, 1)) Then
                MsgBox "Entry already exists: " & Ary(I, 1)
            Else
                Dict.Add Ary(I, 1), MyClass
            End If

        Next I

    Else
        MsgBox "Error while reading Table"
    End If

End Sub

TableHandler and TryReadTable are a class and function that reads a table into a variant array. Field1 and Field 2 are the columns of the Excel table. My tables range from 1 to 8 columns depending on the table.

I don't know how to make these lines generic:

            Dim ThisClass As MyClass
            Set ThisClass = New MyClass

            ThisClass.Field1 = Ary(I, 1)
            ThisClass.Field2 = Ary(I, 2)

At this point I have to make 10-12 versions of MakeDictionary where only the class name and class fields are unique. If that's the best way to do it, I can live with it, but, I'd like to make my code more general. Any suggestions?

Answer 1

Option Explicit!

Suggestion #1: Put Option Explicit at the top of the module. Always!

This would have prevented the very embarrassing error of Dict.Add Ary(I, 1), MyClass. Upon which I see that this code would neither compile nor run unless this Class is a default instance.

Function or Sub?

If you are only returning one value, then you can use a Function, not a Sub.

Keep it Simple!

You have made this more complicated than required. You already pass in a ListObject, and you want the DataRange. Just do that instead of calling custom classes that return something that you then have to modify/clean up.

Dim ThisList As TableHandler
Set ThisList = New TableHandler

Dim Ary As Variant

If ThisList.TryReadTable(Tbl, False, Ary) Then
    [...]

becomes

Dim Ary As Variant
If Not Tbl is Nothing then 
    Ary = Tbl.DataRange
    [...]

In addition, you have pInitialized = True but you don't declare or use pInitialized anywhere else.

Interface or encapsulate?

This is a classic example where the use of an interface would greatly assist. Create an interface class which basically sets up a contract for some of the methods to be used. In other words, make sure that all of these 10-12 Classes you mention have the right method or property so that you can call and create as required.

Public Sub MakeDictionary( _
    ByVal Tbl As ListObject, _
    ByRef Dict As Scripting.Dictionary)

Can become

Public Sub MakeDictionary( _
    ByVal Tbl As ListObject, _
    ByRef Dict As Scripting.Dictionary, 
    ByVal SomeTag as <whatever type is most appropriate>)

And further in the code you can have

    For I = LBound(Ary, 1) To UBound(Ary, 1) '<- remember - we fixed this in my comment above!
        Dim ThisClass As IClass
        Select Case SomeTage
            Case TagA
                Set ThisClass = New MyClass1
            Case TagB
                Set ThisClass = New MyClass2
        End Select

        'ThisClass.Field1 = Ary(I, 1)
        'ThisClass.Field2 = Ary(I, 2)
        ThisClass.RelevantFillMethod(Ary(I, 1),Ary(I, 2))

        If Dict.Exists(Ary(I, 1)) Then ' Just in case there is some sort of transform?
            MsgBox "Entry already exists: " & Ary(I, 1)
        Else
            Dict.Add Ary(I, 1), ThisClass 
        End If
    Next I

Now, if the Interface had a factory method which created a new version of the relevant class - you could dispense with the Dim and pass the MyClass1 instance as a parameter, calling MyClass1.New as necessary.

' Class IClass
Option Explicit

Public Function NewMe() As IClass
End Function

Public Sub RelevantFillMethod(val1 As Variant, val2 As Variant)
End Sub

And

' Class Class1
Option Explicit
Implements IClass


Private p_V1 As Variant
Private P_V2 As String

Public Function EverythingElse()
    '[...]
End Function


Private Function IClass_NewMe() As IClass
    Set IClass_NewMe = New Class1
End Function

Private Sub IClass_RelevantFillMethod(val1 As Variant, val2 As Variant)
    p_V1 = val1
    P_V2 = CStr(val2)
End Sub

Subs and functions!

Of course, you can make this a bit easier by addressing the single responsibility concept and using logical functions. However, in the OP there is not enough information to understand where this logic break is.

Identify and loop through tables
    Create array from table '<= can be a function that returns an array - single responsibility
    Identify relevant Class
    Update Dictionary based on array '<= single responsibility, 
        'parameters could be the array, the dictionary and 
        'the instance of the class based on the interface

For example

Sub UpdateDictionary(ByVal Ary as Variant, ByRef Dict as Dictionary, ThisClass as IClass)    
    For I = LBound(Ary, 1) To UBound(Ary, 1)
        If Dict.Exists(Ary(I, 1)) Then 
            MsgBox "Entry already exists: " & Ary(I, 1)
        Else
            Set ThisClass = ThisClass.NewMe
            ThisClass.RelevantFillMethod(Ary(I, 1),Ary(I, 2))
            Dict.Add Ary(I, 1), ThisClass 
        End If
    Next I
End Sub

Final comments

What I have suggested above may not be the most elegant - but it is a start. Making something generic is about being able to abstract to the relevant layer.

Answer 2

There is no need to instantiate a new instance of MyClass is it already exists and I personally don't like declaring variables inside loops.

   Dim ThisClass As MyClass

    For I = 2 To UBound(Ary, 1)
        If Dict.Exists(Ary(I, 1)) Then
            MsgBox "Entry already exists: " & Ary(I, 1)
        Else
            Set ThisClass = New MyClass
            ThisClass.Field1 = Ary(I, 1)
            ThisClass.Field2 = Ary(I, 2)
            Dict.Add Ary(I, 1), MyClass
        End If
    Next I