Click here to Skip to main content
11,639,520 members (69,679 online)
Rate this: bad
good
Please Sign up or sign in to vote.
See more: Access VBA
Hi,

I receive some tables where there are elements grouped by linked lists and I have trouble to deal with it.

The function works find as it but I'm often asked where is its macro when launched since task scheduler or have some memory issues.

I use the following code to find out the idGroup (translated to English) and I'm wondering if there would by ways to improvise it especially its speed because it takes up to an hour for 30 000 rows and about 2500 groups... (It's why I had 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

Thanks in advance for any hint.

Guillaume.
Posted 4-Oct-12 1:49am
geam6661.2K
Rate this: bad
good
Please Sign up or sign in to vote.

Solution 1

If i understand you well, you're trying to update idGroup to MIN(id2) if idGroup="" And id1="0".
If above is true, you don't need any VBA code, you need only UPDATE[^] query based on the same table.

It could be something like this:
UPDATE LINKED_LISTS AS LL
INNER JOIN (
            SELECT MIN(id2) AS idGroup
            FROM LINKED_LISTS
            WHERE idGroup="" AND id1="0") AS T1 ON LL.id2 = T1.id2
SET  idGroup = T1.idGroup

Examples:
http://www.fmsinc.com/microsoftaccess/query/snytax/update-query.html[^]
http://msdn.microsoft.com/en-us/library/office/bb221186%28v=office.12%29.aspx[^]
http://www.techonthenet.com/access/queries/update2.php[^]
http://stackoverflow.com/questions/871905/use-select-inside-an-update-query[^]

BTW: I'm wondering why id's fields are text fields?
  Permalink  
Comments
geam666 at 3-Mar-13 16:58pm
   
Thank you for your time, Sorry for the long delay but I had been given the full reply on MSDN forum...

I could have use your solution but it only works 90% of the time since it's not always the minimum value and it's nice to know both ways...

The fields are numerics because I had been asked to have them that way...
Maciej Los at 3-Mar-13 17:09pm
   
OK.
If your problem was solved, please, mark this solution as "solved" (formally).
Rate this: bad
good
Please Sign up or sign in to vote.

Solution 2

I didn't solve this myself but I had been given the better reply on MSDN by Vanderghast[^]
  Permalink  

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

  Print Answers RSS
0 OriginalGriff 9,081
1 Sergey Alexandrovich Kryukov 8,812
2 Mika Wendelius 7,027
3 Suvendu Shekhar Giri 2,600
4 F-ES Sitecore 2,548


Advertise | Privacy | Mobile
Web01 | 2.8.150731.1 | Last Updated 3 Mar 2013
Copyright © CodeProject, 1999-2015
All Rights Reserved. Terms of Service
Layout: fixed | fluid

CodeProject, 503-250 Ferrand Drive Toronto Ontario, M3C 3G8 Canada +1 416-849-8900 x 100