building a hierarchy (threeview) with VBA

[shodan]

Hey all,

I think this is a difficult one.

I would like to build a hierarchy in excel using vba which would make it for the users of the spreadsheet much more easy to choose out of a certain list. The hierarchy would exist out 4 levels which are based on a cornertstone.

Is this any clear at all? Does anyone knows if there are good source or maybe scripts on the web which are farely easy to adjust?

Thanks in advance and have a nice weekend !!

 

[sweater_vests_rock]

Hi shodan.

You should look into the VBA Treeview control. Colo's site has a nice explanation.

http://puremis.net/excel/code/080.shtml

If you need more traditional listbox functionality, check out Andy Pope's Hierarchical Listbox.

http://www.andypope.info/vba/hlist.htm

hope these help.
cheers. ben.

 

[shodan]

thanks for the info. in the meanwhile, I also found a great treeview script on this this site:

http://www.geocities.com/dsteppan/ExcelTop.html

now, i would like to adjust it just a bit but i don't really know how.

please see the script (most of it)below:

Dim InputArray As Variant
Dim InputArraySorted As Variant
Dim Flip() As Integer


Sub MakeTreeView()

Dim SortOrderBy As Integer

GetInputArray
SortInputArray
AddNodes

PopulateCombos
frmTreeView.Show

End Sub

Sub AddNodes()

Dim NewNode As Node
Dim OldText() As String
Dim NodeParent() As String

ReDim Flip(1 To UBound(InputArray, 1), 1 To UBound(InputArray, 2))
ReDim NodeParent(1 To UBound(InputArray, 1), 1 To UBound(InputArray, 2))

frmTreeView.TreeView1.Nodes.Clear

For j = 1 To UBound(InputArray, 2)
    Flip(1, j) = 1
Next

For i = 2 To UBound(InputArray, 1)
For j = 1 To UBound(InputArray, 2)
    If InputArray(i, j) = InputArray(i - 1, j) Then
        If j > 1 Then
            If Flip(i, j - 1) = 1 Then
                Flip(i, j) = 1
            Else
                Flip(i, j) = 0
            End If
        Else
            Flip(i, j) = 0
        End If
    Else
        Flip(i, j) = 1
    End If
Next
Next

For j = 1 To UBound(InputArray, 2)
    NodeCount = 1
For i = 1 To UBound(InputArray, 1)
    NodeKey = "NK" & j & NodeCount
    
       If j = 1 Then
        If Flip(i, j) = 1 Then
            Set NewNode = frmTreeView.TreeView1.Nodes.Add(, , NodeKey, InputArray(i, j))
            NodeCount = NodeCount + 1
            NodeParent(i, j + 1) = NodeKey
        Else
            NodeParent(i, j + 1) = NodeParent(i - 1, j + 1)
        End If
       Else
        Debug.Print i, j, NodeKey, InputArray(i, j)
        If Flip(i, j) = 1 Then
            Set NewNode = frmTreeView.TreeView1.Nodes.Add(NodeParent(i, j), tvwChild, NodeKey, InputArray(i, j))
            NodeCount = NodeCount + 1
            If j < UBound(InputArray, 2) Then NodeParent(i, j + 1) = NodeKey
        Else
            If j < UBound(InputArray, 2) Then NodeParent(i, j + 1) = NodeParent(i - 1, j + 1)
        End If
       End If
Next
Next

frmTreeView.lblSummary.Caption = "This view has " & frmTreeView.TreeView1.Nodes.Count & " Nodes"

End Sub
Sub GetInputArray()

ActiveSheet.Activate
ActiveCell.Select
Selection.CurrentRegion.Select
InputArray = Selection.Value

End Sub
Sub SortInputArray()

Dim SortOrderBy As Integer

SortOrderBy = 1
InputArraySorted = MultiColumnSort(InputArray, SortOrderBy)
InputArray = InputArraySorted

End Sub

Sub MakeXLS()

Sheets.Add
Cells(3, 1).Select

For i = 1 To UBound(InputArray, 1)
'j contains the hierarchy level --> level 4 is the lowest hierarchy
j = 4 '1 To UBound(InputArray, 2)
    If Flip(i, j) = 1 Then
        Cells(i + 2, j).Value = InputArray(i, j)
    End If
Next
'Next

'ActiveSheet.Columns("A:Z").AutoFit

'ActiveSheet.Buttons.Add(0.75, 1.5, 21, 15).Select
'Selection.OnAction = "ExpandTree"
'Selection.Characters.Text = "+"

'ActiveSheet.Buttons.Add(22.5, 1.5, 21, 15).Select
'Selection.OnAction = "ContractTree"
'Selection.Characters.Text = "-"
'Cells(3, 1).Select

End Sub

my question is about the XLS export:
i found out myself that "J" stands for the hierarchy and that if J=4 that this is my lowest hierarchy (what an achievement )
I only want to export the lowest hierarchy, and with the small adjustmnt i made, this is possible, but it copies all detail from the lowest level, and I only want to copy the selected item from the lowest level

even better is that if i select a certain level within the hierarchy, it copies all items of the lowest level, which belongs to the selected level.

Oops, is it still clear?
thanks a lot
shodan

ps; how do you determine a value of a selected node?

 

[sweater_vests_rock]

hi shodan.

replacing the MakeXLS subroutine above with the routine below will accomplish one of your goals, which is to output the selected node text to a new worksheet:

Sub MakeXLS()

    Dim wsNew As Worksheet
    Dim strCopyNode As String
    Dim i As Long

    With frmTreeView.TreeView1.Nodes
        For i = 1 To .Count
            If .Item(i).Selected = True Then
                strCopyNode = .Item(i).Text '<-- returns node value
                Exit For
            End If
        Next i
    End With

    Application.ScreenUpdating = False

    Set wsNew = ActiveWorkbook.Worksheets.Add
    
    With wsNew.Cells(1, 1)
        .Value = "Node Output"
        .Font.Underline = True
        .Offset(1, 0).Value = strCopyNode
    End With

    Application.ScreenUpdating = True

End Sub

i'm not sure how to print all items at the lowest level of a selected branch, but i'll think about it.

cheers. ben.

 

[shodan]

Hey Ben,

Many thanks for your help. I've been looking and searching and after a lot of trial and error attempts, I somehow managed indeed to get the selected cells and move them to a new listbox:

For i = 0 To Me.ListBoxadd.ListCount - 1
    If Me.TreeView1.SelectedItem.Text = Me.ListBoxadd.List(i) Then
        MsgBox "dupplicate selections are not allowed !"
        Exit Sub
    End If
Next i

myresult = Worksheets("sheet2").Cells(1, 1).Value Mod 2

If myresult <> 0 Then
    If Mid(frmTreeView.TreeView1.SelectedItem.Key, 3, 1) <> 5 Then
        MsgBox "you can only add items from the lowest hierarchy.  please select an item"
    Else
        frmTreeView.ListBoxadd.AddItem frmTreeView.TreeView1.SelectedItem.Text
    End If

Else: myresult = 0
    If Mid(frmTreeView.TreeView1.SelectedItem.Key, 3, 1) <> 1 Then
        MsgBox "you can only add items from the lowest hierarchy.  please select an item"
    Else
        frmTreeView.ListBoxadd.AddItem frmTreeView.TreeView1.SelectedItem.Text
    
    
    End If
End If

I changed also someother part in the code so that the swap thing (changings between hierarchy is only possible between level 1 and 5. Doing this, I was able to determining the position of the lowest level, even after the swap, using the a part of the key. I don't really know how I managed, but I did lol and that feels good

What I couldn't do is let the swap routine as it was, meaning being abel to swap between all levels, and than still determining the lowest level (the original than i mean).

Now the new goal is to export the items in the new listbox to excel. I'm will check if I can use your example for that.

thanks a lot for trying to help me out!! I really appreciate it

regards
shodan

 

[sweater_vests_rock]

hi shodan.

glad you have almost everything working! here is what i have to export items from your listbox to the worksheet. you'll need to have a userform with a listbox entitled "listbox1" and a commandbutton entitled "commandbutton1" to use this as is.

cheers. ben.

(some testing)

Option Base 1
Private Sub CommandButton1_Click()

    Dim i As Long, j As Long
    Dim aryOutput()
    
    ReDim aryOutput(1 To ListBox1.ListCount, 1)
    
'   Creates an array of values to export
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            j = j + 1
            aryOutput(j, 1) = ListBox1.List(i)
        End If
    Next i
    
'   Exports selected values to new worksheet
    Application.ScreenUpdating = False

    If j > 0 Then
        Set wsNew = Worksheets.Add
        With wsNew
            .Cells(1, 1).Value = "Listbox Output"
            .Cells(1, 1).Font.Underline = True
            .Range(.Cells(2, 1), .Cells(j + 1, 1)).Value = aryOutput
        End With
    End If
    Application.ScreenUpdating = True
    
End Sub

 

[shodan]

Ben,

thanks, but something didn't really worked. I was changing your code a bit, but it still doesn't work. Do you see what is wrong in here? (btw, i want to export the complete listbox, so i don't take into account if they are selected or not. The reason that the items show up in the list box means that they have already been selected.)

Dim i As Long, j As Long
    Dim aryOutput()
    
    ReDim aryOutput(1 To frmTreeView.ListBoxadd.ListCount, 1)
    
'   Creates an array of values to export
    For i = 0 To frmTreeView.ListBoxadd.ListCount - 1
            j = j + 1
            aryOutput(j, 1) = frmTreeView.ListBoxadd.List(i)
    Next i
    
    Application.ScreenUpdating = False

    If j > 0 Then
    Worksheets("CBOM").Activate
    Range(Cells(1, 1), Cells(j + 1, 1)) = aryOutput
  
        'Set wsNew = Worksheets.Add
        'With Worksheets("CBOM")
            '.Cells(1, 1).Value = "Listbox Output"
            '.Cells(1, 1).Font.Underline = True
          '  .Cells(1, 1).Select
            '.Range(.Cells(1, 1), .Cells(j + 1, 1)).Value = aryOutput
    '    End With
    End If
    Worksheets("sheet2").Activate
    Application.ScreenUpdating = True

the code now exports something, but it gives an NA error. Can you also explain me what the ".list" propety does?

Thanks,
shodan

 

[sweater_vests_rock]

hi shodan.

i'm not sure why you were having errors with my code -- things looked good on my end. to test i loaded the listbox from three cells in my worksheet, which may have caused problems? anyways, it sounds like you're doing something else with the listbox than i thought.

since you are exporting the entire listbox, i've redone the export macro to better suit your needs. let me know if you have any problems.

in regards to your question about .List(), .List allows you to access the array which stores the value in the listbox. .Column offers a similar technique. from the VBA help files:

Returns or sets the list entries of a ListBox or ComboBox.

Syntax

object.List( row, column ) [= Variant]

The List property syntax has these parts:

Part Description
object Required. A valid object.
row Required. An integer with a range from 0 to one less than the number of entries in the list.
column Required. An integer with a range from 0 to one less than the number of columns.
Variant Optional. The contents of the specified entry in the ListBox or ComboBox.


Settings

Row and column numbering begins with zero. That is, the row number of the first row in the list is zero; the column number of the first column is zero. The number of the second row or column is 1, and so on.

Remarks

The List property works with the ListCount and ListIndex properties.Use List to access list items. A list is a variant array; each item in the list has a row number and a column number.

Initially, ComboBox and ListBox contain an empty list.

Note To specify items you want to display in a ComboBox or ListBox, use the AddItem method. To remove items, use the RemoveItem method.

Use List to copy an entire two-dimensional array of values to a control. Use AddItem to load a one-dimensional array or to load an individual element.

Private Sub CommandButton1_Click()
'   Exports listbox to new worksheet

    Dim lngListCount As Long
    
    Application.ScreenUpdating = False

    lngListCount = ListBox1.ListCount
    
    If lngListCount > 0 Then
        Set wsNew = Worksheets.Add
        
        With wsNew
            With .Cells(1, 1)
                .Value = "Listbox Output"
                .Font.Underline = True
            End With
            
            .Range(.Cells(2, 1), .Cells(2, 1).Offset(lngListCount - 1, 0)).Value = ListBox1.List()
        End With
        
    End If
    
    Application.ScreenUpdating = True
    
End Sub

 

[shodan]

Ben,

Tx for your help. works like it should now!!

 

[shodan]

Hey guys,

When I'm trying to import the userform with the treeview to another schedule, I'm getting following error:

Line 2: Property OleObjectBlob in frmTreeView could not be set.

Does anyone has an idea what this could mean?

Regards,
shodan