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

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
Set dict = New Scripting.Dictionary

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

'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
rs.MoveNext
Next
End With

'this takes 17 seconds
'With dict
'For i = 1 To rs.RecordCount
'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.

• Pretty sure the difference between the 3 approaches is statistically insignificant – Mathieu Guindon Sep 26 '19 at 16:43
• 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. – Parfait Sep 30 '19 at 14:24

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)
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

• 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. – Whit Sep 27 '19 at 21:49
• 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. – TinMan Sep 28 '19 at 0:20