Access 2007 Improving / vba query for grouping by linked list

Question

I get a few tables where there are items grouped by linked lists, and I have problems with this.

The function works like it, but I am often asked where its macro is when starting from the task scheduler or a memory problem.

I use the following code to find out idGroup (translated into English), and I am wondering if it will be possible to improve it, especially its speed, since it takes up to an hour of 30,000 rows and about 2500 groups ... (This is why I used VBA to see progress ...)

'Simple example 'idGroup,id2,id1 '6338546,14322882,13608969 '6338546,13608969,13255363 '6338546,6338546,14322882 '6338546,11837926,11316332 '6338546,12297571,11837926 '6338546,13255363,12811071 '6338546,12811071,12297571 '6338546,7610194,7343817 '6338546,7935943,7610194 '6338546,8531387,7935943 '6338546,6944491,6611041 '6338546,7343817,6944491 '6338546,9968746,9632204 '6338546,10381694,9968746 '6338546,6611041,0 '6338546,8920224,8531387 '6338546,9632204,8920224 '6338546,11316332,10941093 '6338546,10941093,10381694 Public Function GetidGroup() 'first id1 is always 0 sql = "SELECT idGroup, id2, id1 FROM TABLE_WITH_LINKED_LIST WHERE id1='0' ORDER BY id2 DESC" Dim rs As Recordset Dim uidLikedList As String, id2 As String, id1 As String Set rs = CurrentDb.OpenRecordset(sql) Dim total As Long Dim idGroup As String Dim incrément As Long, progress As Double total = rs.RecordCount incrément = 1 While Not rs.EOF progress = Math.Round(100 * incrément / total, 2) 'Print in order to avoir freezing Debug.Print progress If rs.Fields("idGroup") = "" Then id2 = rs.Fields("id2") idGroup = precedentUid(id2) rs.Edit rs.Fields("idGroup") = idGroup rs.Update End If incrément = incrément + 1 rs.MoveNext Wend rs.Close Set rs = Nothing GetidGroup = total End Function 'Recursive function 'Deepest so far is about 62 calls Public Function precedentUid(id2 As String) As String sql = "SELECT idGroup, id2 FROM TABLE_WITH_LINKED_LIST WHERE id1 = '" & id2 & "'" Dim rs As Recordset Dim precedentid2 As String Dim idGroup As String Dim ret As String Set rs = CurrentDb.OpenRecordset(sql) If rs.EOF Then rs.Close Set rs = Nothing precedentUid = id2 Else 'Some records have several references '56 impacted records : 'TODO : Give the min id2 to the group ret = "-1" While Not rs.EOF If rs.Fields("idGroup") = "" Then precedentid2 = rs.Fields("id2") idGroup = precedentUid(precedentid2) If ret = "-1" Or CLng(ret) > CLng(idGroup) Then ret = idGroup End If 'Debug.Print id2 & " " & precedentid2 & " " & idGroup rs.Edit rs.Fields("idGroup") = idGroup rs.Update End If rs.MoveNext Wend rs.Close Set rs = Nothing precedentUid = ret End If End Function 

Answer 1

Some suggestions:

• You open a large number of record sets (for each call to precedentUid ). Instead, consider using a single record set sorted by idGroup + id1 and search up or down for the corresponding value.
• Since you are always looking for idGroup + id1 , I would suggest that it should be a primary key. You can then use the Seek method for faster searches.
• Once you have the primary key, there is no need for one set of records to be editable, and it will load faster. When you need to update idGroup , use the SQL statement along with CurrentDb.Execute .
• Download the idGroup search idGroup in the Dictionary ( Microsoft Scripting Runtime link in Tools → Links ), so you won’t repeat the search when recursing.
• Your data samples are all numbers, but you extract them from the recordset as strings. The main data type should be Long , not Text . If you have no control over this, I would consider creating a temporary table with the appropriate data types.