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

You could reduce significantly the lookup time by implementing your own hashtable/dictionary.

Here's an example indexing a 4 millions array under 5 seconds:

Private Declare PtrSafe Function RtlComputeCrc32 Lib "ntdll.dll" ( _
  ByVal start As Long, ByVal data As LongPtr, ByVal size As Long) As Long

Sub Example()
  Dim data(), slots() As Long, i As Long

  ' generate some records '

  ReDim data(0 To 1, 0 To 4000000)
  For i = 0 To UBound(data, 2)
    data(0, i) = CStr(i)
  Next

  ' index all the keys from column 1 '

  MapKeys slots, data, column:=0

  ' lookup a key in column 1 '

  i = IndexOfKey(slots, data, column:=0, key:="4876")

  If i >= 0 Then
    Debug.Print "Found at index " & i
  Else
    Debug.Print "Missing"
  End If

End Sub


Public Sub MapKeys(slots() As Long, data(), column As Long)
  Dim bucketsCount&, key$, r&, i&, s&, h&      
  bucketsCount = UBound(data, 2) * 0.9   ' n * load factor '
  ReDim slots(0 To UBound(data, 2) + bucketsCount)

  For r = 0 To UBound(data, 2) ' each record '
    key = data(column, r)
    h = RtlComputeCrc32(0, StrPtr(key), LenB(key)) And &H7FFFFFF  ' get hash '
    s = UBound(slots) - (h Mod bucketsCount)                      ' get slot '
    Do
      i = slots(s) - 1& ' get index (base 0) '

      If i >= 0& Then  ' if index for hash '
        If data(column, i) = data(column, r) Then Exit Do  ' if key present, handle next record '
      Else
        slots(s) = r + 1&  ' add index (base 1) '
        Exit Do
      End If

      s = i  ' collision, index points to the next slot '
    Loop
  Next
End Sub

Public Function IndexOfKey(slots() As Long, data(), column As Long, key As String) As Long
  Dim h&, s&, i&
  h = RtlComputeCrc32(0, StrPtr(key), LenB(key)) And &H7FFFFFF    ' get hash  '
  s = UBound(slots) - (h Mod (UBound(slots) - UBound(data, 2)))   ' get slot  '
  i = slots(s) - 1&                                               ' get index (base 0) '

  Do While i >= 0&
    If data(column, i) = key Then Exit Do  ' break if same key '
    i = slots(i) - 1&                      ' collision, index points to the next slot '
  Loop

  IndexOfKey = i
End Function