VBA Excel Looping through recordset and storing the data to use later
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