Create hierarchy from recordset - list

Question

I have the following problem:
I have to sort the data of a recordset with a hierarchy.
This is the data as it comes from the database.
You see there are two columns, POS and PARENT.
These values must be related to each other.
If PARENT is 0, then the value in the new sort simply gets a consecutive number. In this case 1-3.
The other values each get a new consecutive number, based on the parent.
I'm pretty sure I could solve this problem in C#, but in this case VB6 is mandatory. Unfortunately I have extreme problems solving the problem with VB6.

Answer 1

This looks like a linked list exercise. You can create a clsListItem class that has a FirstChild object and a NextItem object:
Public Position As Integer
Public Hierarchy As String
Public FirstChild As clsListItem
Public NextItem As clsListItem
As you go down the list, you create a new object and look for its parent. You then check if the FirstChild of the parent exists or not. If it doesn't, you Set the object as the FirstChild, otherwise you navigate through children objects using NextItem until NextItem is Nothing. You then Set the object as NextItem:
Public Sub Sort(ByVal p_sList As String)
Dim arrLines
Dim arrFields
Dim iCounter As Integer
Dim objItem As clsListItem
Dim objParent As clsListItem
Dim objChild As clsListItem
Dim iPosition As Integer
Dim iParent As Integer
Dim iParentIndex As Integer
Dim iChildIndex As Integer
' Split values into lines
arrLines = Split(p_sList, vbCrLf)
' Initialize Parent Index
iParentIndex = 1
For iCounter = 1 To UBound(arrLines) + 1
arrFields = Split(arrLines(iCounter - 1), ",")
iPosition = arrFields(0)
iParent = arrFields(1)
' Get Item
Set objItem = GetItem(iPosition)
If iParent = 0 Then
' This is a top-level item
objItem.Hierarchy = iParentIndex
iParentIndex = iParentIndex + 1
Else
' Get Parent
Set objParent = GetItem(iParent)
' Initialize Child Index
iChildIndex = 1
If objParent.FirstChild Is Nothing Then
' We are the first child
Set objParent.FirstChild = objItem
Else
' Find last child
Set objChild = objParent.FirstChild
iChildIndex = iChildIndex + 1
Do While Not objChild.NextItem Is Nothing
Set objChild = objChild.NextItem
iChildIndex = iChildIndex + 1
Loop
Set objChild.NextItem = objItem
End If
objItem.Hierarchy = objParent.Hierarchy & "." & iChildIndex
End If
Next
Dim sMessage As String
For iCounter = 1 To colListItems.Count
Set objItem = colListItems.item(iCounter)
With objItem
sMessage = sMessage & .Position & ": " & .Hierarchy & vbCrLf
End With
Next
MsgBox sMessage
End Sub
That should organize all your data into objects with the desired hierarchy.
Helper function to Get/Create items:
Public Function GetItem(ByVal p_iPosition As Integer) As clsListItem
Dim objItem As clsListItem
On Error GoTo ItemNotFound
Set objItem = colListItems.item("P" & p_iPosition)
GoTo ReturnItem
ItemNotFound:
Set objItem = New clsListItem
objItem.Position = p_iPosition
colListItems.Add objItem, "P" & p_iPosition
ReturnItem:
Set GetItem = objItem
End Function
Finally, the code I used to create the table of values you have (double-check it, could be typo):
Private Function AddPair(ByVal p_sList As String, ByVal p_iPos As Integer, ByVal p_iParent As Integer) As String
Dim sReturn As String
sReturn = p_sList
If sReturn <> "" Then sReturn = sReturn & vbCrLf
sReturn = sReturn & p_iPos & "," & p_iParent
AddPair = sReturn
End Function
and this is the main subroutine:
Private Sub Form_Load()
Dim list As String
list = AddPair(list, 1, 0)
list = AddPair(list, 13, 0)
list = AddPair(list, 16, 0)
list = AddPair(list, 2, 1)
list = AddPair(list, 12, 1)
list = AddPair(list, 3, 2)
list = AddPair(list, 4, 2)
list = AddPair(list, 5, 2)
list = AddPair(list, 6, 2)
list = AddPair(list, 7, 2)
list = AddPair(list, 8, 7)
list = AddPair(list, 11, 7)
list = AddPair(list, 9, 8)
list = AddPair(list, 10, 8)
list = AddPair(list, 14, 13)
list = AddPair(list, 15, 13)
list = AddPair(list, 17, 16)
list = AddPair(list, 18, 16)
Sort (list)
End Sub