I have a loop to add Recordset items to a Dictionary so I can do comparisons and retrieve specific data later in the code (not shown below).

The first loop I tried takes around 17 seconds, the second takes 16 seconds, the third takes 15 seconds. It seems like a long wait to add 500-700 records.

The connection is to a SQL Server database.

'add all apps to dictionary
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set dict = New Scripting.Dictionary
Set rs = New ADODB.Recordset
rs.Open SQLStr2, cn, adOpenStatic

Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer

'This takes 16 seconds - class module separate
'Source: https://codereview.stackexchange.com/questions/25956/storing-recordset-data
'Dim entity As MyEntity
'Dim entities As New Collection
'While Not rs.EOF And Not rs.BOF

    'Set entity = New MyEntity
    'With entity
        '.Property1 = rs.Fields("app_number").value
        '.Property2 = rs.Fields("FlexFstDispAmt").value
        '.Property3 = rs.Fields("FlexSecDispAmt").value
        '.Property4 = rs.Fields("NonFlexAmt").value
    'End With

    'entities.Add entity 

'this takes 15 seconds
Dim Key1 As String
Dim Key2 As String
Dim Key3 As String
Dim Key4 As String
With dict
    For i = 1 To rs.RecordCount
        Key1 = rs.Fields("app_number").value
        Key2 = rs.Fields("FlexFstDispAmt").value
        Key3 = rs.Fields("FlexSecDispAmt").value
        Key4 = rs.Fields("NonFlexAmt").value
        .Add Key1, Array(Key2, Key3, Key4)
        '.Add rs.Fields("app_number").Value, Array(rs.Fields("FlexFstDispAmt").Value, rs.Fields("FlexSecDispAmt").Value, rs.Fields("NonFlexAmt").Value)
End With

'this takes 17 seconds
'With dict
    'For i = 1 To rs.RecordCount
        '.Add rs.Fields("app_number").value, Array(rs.Fields("FlexFstDispAmt").value, rs.Fields("FlexSecDispAmt").value, rs.Fields("NonFlexAmt").value)
'End With

Debug.Print Round(Timer - StartTime, 2)

Set cn = Nothing
Set rs = Nothing

I'd really like some help speeding this up. Anything is appreciated.

  • \$\begingroup\$ Pretty sure the difference between the 3 approaches is statistically insignificant \$\endgroup\$ Commented Sep 26, 2019 at 16:43
  • \$\begingroup\$ so I can do comparisons and retrieve specific data later ... pretty sure you can handle such comparisons in SQL (a language to utilize relations between objects for manipulation and retrieval) without application layer looping. \$\endgroup\$
    – Parfait
    Commented Sep 30, 2019 at 14:24

1 Answer 1


It is much faster to iterate over an array then a recordset. You should also pass the recordset to a function to return the dictionary. The fewer tasks a subroutine performs the better.

Function RecordsetMap(ByRef rs As ADODB.Recordset, ByVal KeyColumn As Long) As Scripting.Dictionary
    Dim Map As New Scripting.Dictionary
    Dim Key, Item, Values
    Rem 1000000 is used to ensure all rows are returned
    Values = rs.GetRows(1000000)

    Dim r As Long, c As Long

    For r = 0 To UBound(Values, 2)
        ReDim Item(0 To UBound(Values))

        For c = 0 To UBound(Values)
            Item(c) = Values(c, r)
        Key = Item(KeyColumn)
        Map.Add Key:=Key, Item:=Item

    Set RecordsetMap = Map

End Function


Dim KeyColumn As Long, n As Long

' Get Field Name Index if not know
For n = 0 To rs.Fields.Count - 1
    If rs.Fields(n).Name = "app_number" Then
        KeyColumn = n
        Exit For
    End If

Set dict = RecordsetMap(rs, KeyColumn)
Dim Item, Key

Debug.Print "Iterating over Keys"
For Each Key In dict.Keys
    Item = dict(Key)
    Debug.Print Join(Item, ",")

Debug.Print "Iterating over Items"
For Each Item In dict.Items
    Debug.Print Join(Item, ",")
  • \$\begingroup\$ Please forgive the lack of knowledge, but how do I place this in my code? Also, when trying to test it, RowData gives an undefined error. \$\endgroup\$
    – Whit
    Commented Sep 27, 2019 at 21:49
  • \$\begingroup\$ I renamed RowData to Item before posting. I updated the code and added example usage. Sorry that I didn't have time for a better review. \$\endgroup\$
    – TinMan
    Commented Sep 28, 2019 at 0:20

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.