Populating a treeview control based on a data range on two columns

Private Sub LoadTV()


    Dim c As Range
    Dim nParent As Node
    Dim nChild As Node
    
    '// Simple code - An error will be raised if attempt to add a node with a key that already exists
    On Error Resume Next
    
    '// Loop through Range A1, A(Number of used rows) - Edit to suit your requirements
    For Each c In Sheet1.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
                
        '// Try and add a node. Key is the cell value.
        '// Keys must be unique, but also MUST be text. Cannot be numeric. If a cell
        '// contains numbers, then use '_' or any other text before the cell value to make it a string
        Set nParent = tv.Nodes.Add(, , c.Value, c.Value)
        
        '/ If an error occurred then this key is already in use
        If Err.Number <> 0 Then
            '// So set a reference to that node - need to add the child node
            Err.Clear
            Set nParent = tv.Nodes(c.Value)
        End If
        
        '// If you want Subcategories unique then use this
        Set nChild = tv.Nodes.Add(nParent, tvwChild, c.Offset(0, 1).Value, c.Offset(0, 1).Value)
        '// otherwise
        '// Set nChild = tv.Nodes.Add(nParent, tvwChild, , c.Offset(0, 1).Value)
        '// Clear any error if adding unique child nodes - otherwise it could interfere with adding parent nodes.
        Err.Clear
    Next
            
End Sub

'// Try and add a node. Key is the cell value.
         '// Keys must be unique, but also MUST be text. Cannot be numeric. If a cell
         '// contains numbers, then use '_' or any other text before the cell value to make it a string
        Set nParent = tv.Nodes.Add(, , c.Value, c.Value)
         
         '/ If an error occurred then this key is already in use
        If Err.Number <> 0 Then
             '// So set a reference to that node - need to add the child node
            Err.Clear
            Set nParent = tv.Nodes(c.Value)
        End If
         
        nParent.Expanded = True

'// Move to Initialise event... this is just what I used to test
Private Sub CommandButton1_Click()


     
    Dim c As Range
    Dim nParent As Node
    Dim nChild As Node
     
     '// Simple code - An error will be raised if attempt to add a node with a key that already exists
    On Error Resume Next
     
    tv.Nodes.Clear
    
    '// **** Changed - Have added a ROOT node (Caption from A1 ***
    '// Add the 'ROOT' item
    tv.Nodes.Add , , "ROOT", Range("A1").Value
    tv.Nodes(1).Enpanded = True
    
    '// **** Changed - now loops from Cell A2
     '// Loop through Range A1, A(Number of used rows) - Edit to suit your requirements
    For Each c In Sheet1.Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
         
        '// Try and add a node. Key is the cell value.
        '// Keys must be unique, but also MUST be text. Cannot be numeric. If a cell
        '// contains numbers, then use '_' or any other text before the cell value to make it a string
        
        '// **** Changed - 'Parent' nodes are now added as a child of ROOT
        Set nParent = tv.Nodes.Add("ROOT", tvwChild, c.Value, c.Value)
        '// Changed - Store the cell address in the TAG property. This can be used to
        '// create a Range , as mentione din your post
        nParent.Tag = c.Address
        
         '/ If an error occurred then this key is already in use
        If Err.Number <> 0 Then
             '// So set a reference to that node - need to add the child node
            Err.Clear
            Set nParent = tv.Nodes(c.Value)
        End If
         
        nParent.Expanded = True
        
         '// If you want Subcategories unique then use this
        Set nChild = tv.Nodes.Add(nParent, tvwChild, c.Offset(0, 1).Value, c.Offset(0, 1).Value)
        ' **** Changed - Add Cell address to child TAG property
        nChild.Tag = c.Offset(0, 1).Address
        
         '// otherwise
         '// Set nChild = tv.Nodes.Add(nParent, tvwChild, , c.Offset(0, 1).Value)
         '// Clear any error if adding unique child nodes - otherwise it could interfere with adding parent nodes.
        Err.Clear
    Next
     
End Sub








Private Sub CommandButton2_Click()


    Dim n As Node
    
    For Each n In tv.Nodes
          
        '// Skip the first node - this has no parent
        If n.Index > 1 Then
            If n.Checked And n.Parent.Key = "ROOT" Then
                MsgBox "Parent node - " & n.Text
            End If
        End If
    Next
End Sub

Sub x()


    Dim n As Node
    
    '// For each node
    For Each n In tv.Nodes
        
        '// If not the first node ("Category", key = "ROOT") and it is checked
        If n.Index > 1 And n.Checked = True Then
            
            '// All nodes now have a parent - that's why I added the 'CATEGORY' node as the root
            '// So if the parent of this node has the key "ROOT", then call one procedure
            '// The TAG property contains the cell address (as a string) this node was loaded from.
            '// This can easily be converted to a range using RANGE() in the called procedure
            If n.Parent.Key = "ROOT" Then
                RunCategoryProcedure n.Tag
            Else
                '// Otherwise, it's a Child node. Call a different procedure
                RunItemProcedure n.Tag
            End If
        End If
    Next
End Sub

Option Explicit
Dim ws As Excel.Worksheet


Private Sub lb_Change()


    SetFilter
    
End Sub




Private Sub UserForm_Initialize()


    Dim c As Excel.Range
    Dim x As Excel.Range
    Dim lngLastRow As Long
    
    Set ws = ActiveSheet
    
    With ws
    
        lngLastRow = .Range("A" & Rows.Count).End(xlUp).Row
    
        If .FilterMode Then .ShowAllData
        
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A2:A" & CStr(lngLastRow)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("B2:B" & CStr(lngLastRow)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            '// *** Change Z to suit your max column ***
            .SetRange Range("A1:Z" & CStr(lngLastRow))
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    
        .Range("A1:B" & CStr(lngLastRow)).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    
        Set c = .Range("A1:A" & CStr(lngLastRow)).SpecialCells(xlCellTypeVisible)
            
        For Each x In c
            If x.Row > 1 Then
                lb.AddItem x.Value
                lb.List(lb.ListCount - 1, 1) = x.Offset(0, 1).Value
            End If
        Next
    End With
    
End Sub




Private Sub SetFilter()
    
    Dim cFilterRange As Excel.Range
    Dim iTemp As Integer
    
    Dim xItems As Variant
    ReDim xItems(0)
    
    On Error GoTo ErrHandler
    
    Application.ScreenUpdating = False
    
    '// Set the Range to be AutoFiltered - basically everything on the sheet
    Set cFilterRange = ws.Range("A1").CurrentRegion


    '// The filter will only be applied to Col B - Logic falls down if there
    '// are duplicates. Example: Water, Fizzy and Denture tables, Fizzy (what an example!)
    
    '// Loop all Items
    For iTemp = 0 To lb.ListCount - 1
        
        '// If it's checked and has no children
        If lb.Selected(iTemp) Then
            
            '// Add to Array
            xItems(UBound(xItems)) = lb.List(iTemp, 1)
            '// Resize the array for the next item
            ReDim Preserve xItems(UBound(xItems) + 1)
        End If
    Next
    
    If UBound(xItems) > 0 Then
        '// apply the filter
        cFilterRange.AutoFilter Field:=2, Criteria1:=xItems, Operator:=xlFilterValues
    Else
        If ws.FilterMode Then ws.ShowAllData
    End If
ErrHandler:
    
    Application.ScreenUpdating = True
     
    Exit Sub
    
    '// This is just here for debugging
    Resume
    
End Sub