VBA Excel Looping through recordset and storing the data to use later

Question

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 
 'rs.MoveNext 
'Wend
'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)
 rs.MoveNext
 Next
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)
 'rs.MoveNext
 'Next
'End With
Debug.Print Round(Timer - StartTime, 2)
rs.Close
cn.Close
Set cn = Nothing
Set rs = Nothing

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

• Mathieu Guindon: Pretty sure the difference between the 3 approaches is statistically insignificant
• Parfait: 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.

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)
 Next
 Key = Item(KeyColumn)
 Map.Add Key:=Key, Item:=Item
 Next
 Set RecordsetMap = Map
End Function

---

Usage

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
Next
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, ",")
Next
Debug.Print
Debug.Print "Iterating over Items"
For Each Item In dict.Items
 Debug.Print Join(Item, ",")
Next

• Whit: 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.
• TinMan: 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.