December’s Course of the Month is now available! Enroll to learn ITIL® Foundation best practices for delivering IT services effectively and efficiently.
(Please note that I know the code is not attached to a treeview - yet ! )
Sub trial_ranges_dictionary() Dim a(), c() Dim i, k, l As Long Dim TaskRships As Range Dim taskItems As Range Dim parents As Object Dim children As Object Dim intParentCol As Integer Dim intChildCol As Integer Dim arrRel1() Dim arrRel2() ' Define the column numbers for the parents and children in the task relationships range. intParentCol = 1 intChildCol = 2 Set parents = CreateObject("scripting.dictionary") Set children = CreateObject("scripting.dictionary") ' Use the dynamically named ranges as the base range of data. Set taskItems = Range("TaskIDNames") Set TaskRships = Range("ParentTaskIDs") 'Build a list of parents at level 0 k = 1 l = 0 For Each rw In TaskRships.Rows If k = 1 Then parents.Add rw.Columns(intParentCol).Value, 0 k = k + 1 Else If parents.exists(rw.Columns(intParentCol).Value) Then GoTo nextloop Else k = k + 1 parents.Add rw.Columns(intParentCol).Value, 0 End If End If nextloop: Next rw a = parents.keys ' Build a list of children 'Build a list of unique children parts - level 1 k = 1 l = 0 For Each rw In TaskRships.Rows If k = 1 Then children.Add rw.Columns(intChildCol).Value, 1 k = k + 1 Else If children.exists(rw.Columns(intChildCol).Value) Then GoTo nextloop1 Else children.Add rw.Columns(intChildCol).Value, 1 k = k + 1 End If End If nextloop1: Next rw b = children.keys ' Build a list of parents that are also children. Those that are not children are top level parent items. ' for each parent test to see if it exists in the children list. 'Remove any parent item that is also in the child list, leaving on top level parent items. For i = 0 To UBound(a) If children.exists(a(i)) Then parents.Remove a(i) End If Next i ' List the top level parent items. a = parents.keys ' Now - build a list of children with their related parents - recursively build lists and add nodes to the treeview. Note :not working yet !! ' perhaps call another sub / function to be called no matter how many levels deep it goes. ' Figure out a way to sort the entries based on a sequence number. If no sequence number given, then just sort on the order they arrive. i = 1 For i = 0 To UBound(b) children.Remove b(i) Next i 'Build a full (non-unique) list of children parts with parents - level 1 k = 1 i = 0 ' Use an array to capture all of the parent and child relationships. For Each rw In TaskRships.Rows arrRel1(i) = (rw.Columns(intParentCol).Value) arrRel2(i) = (rw.Columns(intChildCol).Value) Debug.Print arrRel1(i), arrRel2(i) i = i + 1 Next rw ' Match the parents list to the first level children items. ' In the following code, replace debug.print with node.add to build the treeview For i = LBound(a) To UBound(a) For j = 0 To lngChildUbound - 1 ' UBound(arrRel1) If arrRel1(j) = a(i) Then Debug.Print , , arrRel2(j) 'Insert function that checks for the existence of the child in the parent side 'If the child exists as a parent, then iterate and add nodes - have an add_child sub / function that calls itself. If checkforparent(arrRel1, arrRel2(j)) Then Debug.Print "Child exists as a parent" End If End If Next j Next i End Sub
'Subscript out of range'error on line 94 of the above code.
dim arrRel1(10000), arrRel2(10000)