VBA TreeView Control

[AndyJM87]

Hello,

I have a Tree View control on a user form, which pulls the nodes from a Data sheet.

For some reason, it is removing duplicates.

Private Sub UserForm_Initialize()
    Dim cell As Range
    Dim nParent As Node
    Dim nChild As Node
    Application.ScreenUpdating = False
    
    On Error Resume Next
    
     '// Range
    For Each cell In Sheets("DATA").Range("A5:A15000")
        
        Set nParent = tv.Nodes.Add(, , cell.Value, cell.Value)
        
         '// Error handler
        If Err.Number <> 0 Then
            Err.Clear
            Set nParent = tv.Nodes(cell.Value)
        End If
        
         '// Subcategories
        Set nChild = tv.Nodes.Add(nParent, tvwChild, cell.Offset(0, 1).Value, cell.Offset(0, 1).Value)

        Err.Clear
        
    Next
    
    For Each cell In Sheets("DATA").Range("B5:B15000")
        Set nParent = tv.Nodes.Add(, , cell.Value, cell.Value)
        
        If Err.Number <> 0 Then
            Err.Clear
            Set nParent = tv.Nodes(cell.Value)
        End If
        
        Set nChild = tv.Nodes.Add(nParent, tvwChild, cell.Offset(0, 1).Value, cell.Offset(0, 1).Value)
        Err.Clear
        
    Next
    
    For Each cell In Sheets("DATA").Range("C5:C15000")
        Set nParent = tv.Nodes.Add(, , cell.Value, cell.Value)
        
        If Err.Number <> 0 Then
            Err.Clear
            Set nParent = tv.Nodes(cell.Value)
        End If
        
        Set nChild = tv.Nodes.Add(nParent, tvwChild, cell.Offset(0, 1).Value, cell.Offset(0, 1).Value)
        Err.Clear
        
    Next
    
    For Each cell In Sheets("DATA").Range("D5:D15000")
        Set nParent = tv.Nodes.Add(, , cell.Value, cell.Value)
        
        If Err.Number <> 0 Then
            Err.Clear
            Set nParent = tv.Nodes(cell.Value)
        End If
        
        If cell.Offset(0, 1).Value = "_(blank)" Then
            Set nChild = tv.Nodes.Add(nParent, tvwChild, cell.Offset(0, 2).Value, cell.Offset(0, 2).Value)
        ElseIf cell.Offset(0, 1).Value <> "_(blank)" Then
            Set nChild = tv.Nodes.Add(nParent, tvwChild, cell.Offset(0, 1).Value, cell.Offset(0, 1).Value)
        End If
        
        Err.Clear
        
    Next
    
    tv.Nodes.Item("SV").Expanded = True
    
    Application.ScreenUpdating = True
End Sub

So Range C has 4 options which expand. Range D contains duplicates as the 4 options in Range C require the same options in Range D.

Hope this makes sense.

 

[Worf]

Hello

Were you able to solve this one?