UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
2 Pages V < 1 2  (Go to first unread post)
   Reply to this topicStart new topic
> Recussive - Sort By Hierarchy, Access 2016    
 
   
MajP
post Feb 21 2020, 12:19 AM
Post#21



Posts: 15
Joined: 30-January 20



You seem to be quoting some of my code from 10 years ago. Nice to see. I will give you the solution on this tomorrow. It is late here. I have a lot of recursive Access stuff. There are few people who know more about doing this in Access than me. You can take a look at this thread, the answer is in there but you will have to dig for it, but I was doing some complicating calculations. You will see all the "family trees" in proper sort order. Are you interested in Treeviews, because I have some good code on that.

https://www.access-programmers.co.UK/forums...reeding.302630/

If I under stand your question you simply want to put a sort order so that it will print out in a logical order. I do that all the time. In the table I have a field called sort and store that order in the table. Dynamically in a query may not be possible

CODE
1           1
  1.1      2
  1.2      3
2           4
3           5
  3.1      6
  3.2      7
  3.3      8


Attached File  Clipboard01.jpg ( 90.47K )Number of downloads: 2

This post has been edited by MajP: Feb 21 2020, 12:21 AM
Go to the top of the page
 
MajP
post Feb 21 2020, 12:33 AM
Post#22



Posts: 15
Joined: 30-January 20



This code is the gist of recursively looping hierarchical data in vba.
This builds a tree view so if you can take out all the node stuff and just follow the looping logic, that is how you would loop and get your sort order
So forget about the treeview stuff and focus on the recordset.

CODE
Public Sub AddRecursiveRecords(NodeQueryName As String, RootParentID As String)
   'Parent and Child IDs are numeric see the instructions on concatenation to make them strings
   Dim strCriteria As String
   Dim bk As String
   Dim NodeID As String
   Dim NodeText As String
   Dim CurrentNode As clsNode
   Dim NodeLevel As String
  
   Set Me.NodeRecordset = CurrentDb.OpenRecordset(NodeQueryName, dbOpenDynaset)
   strCriteria = "ParentID = '" & RootParentID & "'"
   Me.NodeRecordset.FindFirst strCriteria
   If Me.NodeRecordset.NoMatch Then
    MsgBox "There is no record with a Parent ID of " & RootParentID
   End If
   Do Until Me.NodeRecordset.NoMatch
    NodeID = Me.NodeRecordset.Fields("NodeID")
    NodeText = Me.NodeRecordset.Fields("NodeText")
    NodeLevel = Me.NodeRecordset.Fields("NodeLevel")
    Set CurrentNode = Me.Treeview.AddRoot(NodeID, NodeText)
    With CurrentNode
       .Tag = NodeLevel
       .Bold = True
      .Expanded = False
    End With
    bk = Me.NodeRecordset.Bookmark
    Call AddRecursiveBranch(NodeID, NodeLevel, CurrentNode)
    'ensure you return back to where you were since the bookmark is moving in recursive calls
    Me.NodeRecordset.Bookmark = bk
    Me.NodeRecordset.FindNext strCriteria
  Loop
  Me.Treeview.Refresh
End Sub
Private Sub AddRecursiveBranch(ByVal ParentID As Variant, ByVal NodeLevel, ParentNode As clsNode)

  On Error GoTo errLable
  Dim strCriteria As String
  Dim bk As String
  Dim NodeID As String
  Dim NodeText As String
  Dim CurrentNode As clsNode

  strCriteria = "ParentID = '" & ParentID & "'"
  Me.NodeRecordset.FindFirst strCriteria
  
  Do Until Me.NodeRecordset.NoMatch
    NodeID = Me.NodeRecordset.Fields("NodeID")
    NodeText = Me.NodeRecordset.Fields("NodeText")
    NodeLevel = Me.NodeRecordset.Fields("NodeLevel")
    Set CurrentNode = ParentNode.AddChild(NodeID, NodeText)
    With CurrentNode
       .Tag = NodeLevel
       .Bold = False
      .Expanded = False
    End With

   bk = Me.NodeRecordset.Bookmark
   'Recursive call
   Call AddRecursiveBranch(NodeID, NodeLevel, CurrentNode)
   Me.NodeRecordset.Bookmark = bk
   Me.NodeRecordset.FindNext strCriteria
  Loop
Exit Sub
errLable:
  MsgBox Err.Number & " " & Err.Description & " In addBranch"
  If MsgBox("Do you want to exit the loop?", vbYesNo, "Error In Loop") = vbYes Then
     Exit Sub
   Else
     Resume Next
   End If
End Sub
Go to the top of the page
 
MajP
post Feb 21 2020, 12:57 AM
Post#23



Posts: 15
Joined: 30-January 20



So here is a little more to digest. Here is a recursive call where an object has two parents. It is writing the "sort leve" to a table. Give you some ideas.

CODE
Private Sub AddRecursiveMaleParent(rsBird As DAO.Recordset, StartingBirdID As Long, ByVal FatherRing As String, Generation As Long)
  'This is a confusing name.  Not adding the Father node but adding a child who has this bird as the father
  On Error GoTo errLable
  Dim strCriteria As String
  Dim bk As String
  Dim BirdID As Long
  Dim BirdRingNo As String
  Dim strSql As String
  strCriteria = "FatherID = '" & FatherRing & "'"
  rsBird.FindFirst strCriteria
  'Debug.Print strCriteria
  Do Until rsBird.NoMatch
   ' Debug.Print "match"
    BirdID = rsBird.Fields("ID")
    BirdRingNo = rsBird.Fields("RingNo")
    bk = rsBird.Bookmark
    
    strSql = "Insert INTO tbl_OffSpring (BirdID, OffSpringID, Generation ) VALUES (" & StartingBirdID & ", " & BirdID & ", " & Generation & ")"
    'Debug.Print strSql
    CurrentDb.Execute strSql

    Call AddRecursiveMaleParent(rsBird, StartingBirdID, BirdRingNo, Generation + 1)
   rsBird.Bookmark = bk
   rsBird.FindNext strCriteria
  Loop
Exit Sub
errLable:
  MsgBox Err.Number & " " & Err.Description & " In addrecursiveMaleParent"
  If MsgBox("Do you want to exit the loop?", vbYesNo, "Error In Loop") = vbYes Then
     Exit Sub
   Else
     Resume Next
   End If
End Sub
Private Sub AddRecursiveFemaleParent(rsBird As DAO.Recordset, StartingBirdID As Long, ByVal MotherRing As String, Generation As Long)
  'This is a confusing name.  Not adding the Mother node but adding a child who has this bird as the Mother
  On Error GoTo errLable
  Dim strCriteria As String
  Dim bk As String
  Dim BirdID As Long
  Dim BirdRingNo As String
  Dim strSql As String
  strCriteria = "MotherID = '" & MotherRing & "'"
  rsBird.FindFirst strCriteria
  'Debug.Print strCriteria
  Do Until rsBird.NoMatch
    Debug.Print "match"
    BirdID = rsBird.Fields("ID")
    BirdRingNo = rsBird.Fields("RingNo")
    bk = rsBird.Bookmark
    
    strSql = "Insert INTO tbl_OffSpring (BirdID, OffSpringID, Generation ) VALUES (" & StartingBirdID & ", " & BirdID & ", " & Generation & ")"
    'Debug.Print strSql
    CurrentDb.Execute strSql

    Call AddRecursiveFemaleParent(rsBird, StartingBirdID, BirdRingNo, Generation + 1)
   rsBird.Bookmark = bk
   rsBird.FindNext strCriteria
  Loop
Exit Sub
errLable:
  MsgBox Err.Number & " " & Err.Description & " In addrecursiveFemaleParent"
  If MsgBox("Do you want to exit the loop?", vbYesNo, "Error In Loop") = vbYes Then
     Exit Sub
   Else
     Resume Next
   End If
End Sub
Go to the top of the page
 
damian.green
post Feb 21 2020, 10:18 AM
Post#24



Posts: 171
Joined: 24-October 18



MajP - Thanks for engaging on this string.... Yes I had found your code and started to leverage it. Attached is the mock database with a treeview form that I'm trying to make work. I'm coming up short and would love some assistance.
Attached File(s)
Attached File  Hierarchy_Treeview.zip ( 37.22K )Number of downloads: 2
 
Go to the top of the page
 
MajP
post Feb 21 2020, 11:42 AM
Post#25



Posts: 15
Joined: 30-January 20



I will try to look at it this evening. I am on US East coast time
Go to the top of the page
 
damian.green
post Feb 21 2020, 11:44 AM
Post#26



Posts: 171
Joined: 24-October 18



Thank you.
Go to the top of the page
 
MajP
post Feb 21 2020, 10:37 PM
Post#27



Posts: 15
Joined: 30-January 20



Attached File  Treeview.jpg ( 86.92K )Number of downloads: 2


I apologize for not posting the answer here, but here it is
https://www.access-programmers.co.UK/forums...m-class.309753/

I was sharing this info with some other people asking the same question. Also I am not that active on this forum and I guess you will have future questions. I have so much tree view stuff, I built your solution in a few minutes. Separately I built the sort routine because it helps demonstrate the concepts.
This post has been edited by MajP: Feb 21 2020, 10:58 PM
Go to the top of the page
 
damian.green
post Feb 21 2020, 10:58 PM
Post#28



Posts: 171
Joined: 24-October 18



Thank you so much. Looking forward to additional updates.
Go to the top of the page
 
2 Pages V < 1 2


Custom Search


RSSSearch   Top   Lo-Fi    29th March 2020 - 09:16 AM