CODEWITHSUNDEEP
excelvbatreeviewpopulate
Shan
Shan

Reputation: 439

Populating TreeView with column header and subheader

I am new to tree view control and would like to populate my TreeView (two columns) with the header column as parent node and sub header as child nodes as shown:

tree view

I have started with the following code but I am stuck with it: 

Sub UserForm_Initialize()

    Dim WB As Workbook
    Dim WS As Worksheet
    Dim HeaderRng As Range
    Dim rng As Range
    Dim rCell As Range
    Dim i As Long
    Dim Nod As Node

    Set WB = ThisWorkbook
    Set WS = WB.Worksheets("Data")
    Set HeaderRng = WS.Range("A1:M1")

    With Me.TreeView1.Nodes
        .Clear
        For Each rCell In HeaderRng
            .Add Key:=rCell.Value, Text:=rCell.Value
        Next rCell
    End With

    TreeView1.CheckBoxes = True
    TreeView1.Style = tvwTreelinesPlusMinusText
    TreeView1.BorderStyle = ccFixedSingle

End Sub

Upvotes: 2

Views: 1836

Answers (1)

PatricK
PatricK

Reputation: 6433

Thanks for the introducing the TreeView to my knowledge! With the help of this article, I have got it working with your conditions.

Design view | Executed of the userform:
Design Running_expanded

Code (updated to accommodate out of order Groups in HeaderRng):

Option Explicit

Sub UserForm_Initialize()
    With Me.TreeView1
        .BorderStyle = ccFixedSingle
        .CheckBoxes = True
        .Style = tvwTreelinesPlusMinusText
        .LineStyle = tvwRootLines
    End With

    UpdateTreeView
End Sub

Private Sub UpdateTreeView()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim HeaderRng As Range
    Dim rng As Range
    Dim sCurrGroup As String
    Dim sChild As String
    Dim oNode As Node

    Set WB = ThisWorkbook
    Set WS = WB.Worksheets("Data")
    With WS ' Row A are Header/Groups
        Set HeaderRng = Intersect(.Rows(1), .UsedRange)
    End With

    With Me.TreeView1
        With .Nodes
            '.Clear
            sCurrGroup = ""
            For Each rng In HeaderRng
                'Debug.Print "rng: " & rng.Address & " | " & rng.Value
                sCurrGroup = rng.Value
                ' Add Node only if it does NOT exists
                Set oNode = Nothing
                On Error Resume Next
                Set oNode = .Item(sCurrGroup)
                If oNode Is Nothing Then
                    'Debug.Print "Adding Group: " & sCurrGroup
                    .Add Key:=sCurrGroup, Text:=sCurrGroup
                End If
                On Error GoTo 0

                ' Add the Child below the cell
                sChild = rng.Offset(1, 0).Value
                'Debug.Print "Adding [" & sChild & "] to [" & sCurrGroup & "]"
                .Add Relative:=sCurrGroup, Relationship:=tvwChild, Key:=sChild, Text:=sChild
            Next
        End With
        For Each oNode In .Nodes
            oNode.Expanded = True
        Next
    End With

    Set HeaderRng = Nothing
    Set WS = Nothing
    Set WB = Nothing
End Sub

Upvotes: 1

Related Questions