How to reduce the time cost while looping in a 4 million array in VBA?

Question

I need to do the ‘vlookup’ function using the VBA. I need to lookup data from a access database containg 4.6 million records.

Private Sub connectDB()
 Dim sqlst         


        

Answer 1

Although scripting dictionary is pretty fast at performing lookups, loading one up gets progressively slower the more you put into it: when you're in the millions of items then it gets really slow to load.

So, you could maybe consider something like splitting your values across an array of dictionary objects. All other excellent suggestions aside, this would at least reduce your runtime with your current setup. The only caveat is the "keys" queried from your database would need to be unique.

Sub LookupTester()

    Const NUM_VALUES As Long = 4000000# '<< size of total dataset
    Const MAX_PER_DICT As Long = 400000 '<< max # of entries per dictionary

    Dim numDicts As Long, i As Long, n, t, d, v, r, c As Long
    Dim arrD() As Scripting.Dictionary

    numDicts = Application.Ceiling(NUM_VALUES / MAX_PER_DICT, 1)
    ReDim arrD(1 To numDicts)
    'initialize the array of dictionaries
    For n = 1 To numDicts
        Set arrD(n) = New Scripting.Dictionary
    Next n

    t = Timer
    n = 1
    c = 0
    Set d = arrD(n)

    'Load up some dummy data...
    For i = 1 To NUM_VALUES
        d("Value_" & i) = i
        c = c + 1
        If i Mod 400000 = 0 Then Debug.Print "Store", i, Timer - t 'check progresss
        If c = MAX_PER_DICT Then
            n = n + 1
            If i <> NUM_VALUES Then Set d = arrD(n)'<< next dict
            c = 0
        End If
    Next i
    'Done storing: 87 sec in my test


    t = Timer
    Randomize
    'perform a million lookups
    For i = 1 To 1000000#
        v = "Value_" & CLng(Rnd() * NUM_VALUES)
        For n = 1 To numDicts
            If arrD(n).Exists(v) Then
                r = arrD(n)(v) '<< lookup result
                Exit For
            End If
        Next n
        If i Mod 100000 = 0 Then Debug.Print "Query", i, Timer - t
    Next i
    'Done querying: ~320 sec to run the queries

End Sub

You could wrap up this type of thing into a nice class...