PDA

View Full Version : Userform Treeview



stapuff
07-11-2007, 12:47 PM
I have attached a post similiar to what I need.

In the post column A for lack of a better term is a static value "EMEA" - single parent
column B is parent, & column C is child
http://www.vbaexpress.com/forum/attachment.php?attachmentid=2832&d=1140774268

My data is set up similiar, however, column A has multiple parents, b is child, d is child of b, and e is a child d. C is not needed.

What I would like to do is change the following to allow for multiples:

.Add , , oWS.Range("A2"), oWS.Range("A2")
iLastRow = oWS.Cells(oWS.Rows.Count, "A").End(xlUp).Row
sLevel1 = oWS.Range("A2").Value

And allow for a 3rd level.



Private Sub fill_in_tree()
Dim oWS As Worksheet
Dim iLastRow As Long
Dim i As Long
Dim sLevel1 As String
Dim sLevel2 As String
Dim sLevel3 As String
Set oWS = Worksheets("Prod_Struct")

With Me

'set treeview to our preferred style
.TreeView1.Sorted = False
.TreeView1.LineStyle = tvwRootLines
With .TreeView1.Nodes
.Clear
'load outline treeview
.Add , , oWS.Range("A2"), oWS.Range("A2")
iLastRow = oWS.Cells(oWS.Rows.Count, "A").End(xlUp).Row
sLevel1 = oWS.Range("A2").Value
On Error Resume Next
For i = 2 To iLastRow
If oWS.Cells(i, "B").Value <> sLevel2 Then
.Add sLevel1, tvwChild, oWS.Cells(i, "B").Value, oWS.Cells(i, "B").Value
sLevel2 = oWS.Cells(i, "B").Value
Do Until oWS.Cells(i, "B").Value <> sLevel2
.Add oWS.Cells(i, "B").Value, tvwChild, _
oWS.Cells(i, "B").Value & "-" & oWS.Cells(i, "D").Value, oWS.Cells(i, "D").Value
i = i + 1
Loop
i = i - 1
End If
Next i
On Error GoTo 0
End With
End With
End Sub


Any help would be appreciated.

BTW the code is from a Userform_Initialize
Call fill_in_tree

Thanks for the idea's Kaizer / xld

stapuff
07-11-2007, 01:01 PM
I have attached a sample of my data.

Ken Puls
07-12-2007, 09:05 AM
Hi there,

Give this a shot. Adapted from my article here (http://www.excelguru.ca/node/85).

I didn't add any way to fire the userform, so you'll want to do that from the VBE.

HTH,

stapuff
07-12-2007, 12:31 PM
Ken -

I read your article about a hundred times before I posted. I seen it a hundred different place (websites) too. Just seemed not to be able to get my head around it.

Since I posted - I came up with a loop inside a loop, which provided me with what I needed minus the Qty on hand. Your's is much, much faster.
My range is actually A3:A20000 so I know it's fast.

I have tested your code and have the following issue:
sParentWH = "05" give me an Invalid Key error.
My data comes from a get external data connection and I have Terminal's named 05,07, & 09 that this code fails on. If I change sParentWH = "05" to "sParentWH" = "05" it works for 05,07, & 09 but nothing else.
What might you suggest?


I have something else I would like to put this on - which would be part of a multipage userform.

On multipage 2 selection the treeview Whse Node = UserForm2.MultiPage1(2).TextBox20.Value. Only the part #'s for the sParentWH would get populated?

Ken - you did an outstanding job. I truely appreciate it.

BTW - how has the rain been this year in BC? I use to live 45 minutes directly South of Victoria.

Ken Puls
07-12-2007, 03:12 PM
45 minutes South Of or South In? South of Victoris gets pretty wet in a real hurry! We had a pretty cold spring, but temperature was 36 Celsius here yesterday and is currently 27. (That's the lowest it got in my house last night!)

At any rate...

I'm trying to visualize how things are set up for you on this. I believe that an error is caused when you try to add the same key, or when you try to add a subkey using an undefined parent. I'd be setting up an error trap to figure out what's going on. Maybe just a simple:

Sub Name()
'Code...
On error goto ErrorTrap
'Line that it fails on here
on error goto 0
'More code
Exit Sub

ErrorTrap:
Stop
Resume

End Sub

EDIT: Intention is that when you hit the stop statement, it will break and you can step through the code. Use the locals window to see what values already exist or some debuggin statements to feed the values into the immediate window. :)

Re the multipage part... you could just set it so that the node is only added if it's value meets the sParentWH value in the textbox, couldn't you?

Ken Puls
07-12-2007, 03:27 PM
By the way...

This is a variant of the above that will work if the list is out of order. It might take a little longer to run, as it has to evaluate if each item has already been added to the tree, but may solve the issue you have above as well:
Private Sub TreeView_Populate()
'Purpose: Populate the treeview control

Dim ws As Worksheet
Dim cl As Range
Dim sParentWH As String
Dim sParentsList As String
Dim sParentPart As String
Dim sParentPartList As String
Dim sChildPart As String
Dim sChildPartList As String

With Me.TreeView1.Nodes
'Clear TreeView control
.Clear

For Each cl In Worksheets(1).Range("A2:A29")

'Check if parent has already been added
sParentWH = cl.Value
If Not bItemExists(sParentsList, sParentWH) Then
'Parent not in array so add to string and add node
sParentsList = sParentsList & "," & sParentWH
.Add Key:=sParentWH, Text:=sParentWH
End If

'Add parent Part # if necessary
sParentPart = cl.Offset(0, 1).Value
If Not bItemExists(sParentPartList, sParentWH & "-" & sParentPart) Then
'Parent Part not in array so add to string and add node
sParentPartList = sParentPartList & "," & sParentWH & "-" & sParentPart
.Add relative:=sParentWH, _
relationship:=tvwChild, _
Key:=sParentWH & "-" & sParentPart, _
Text:=sParentPart
End If

'Add child Part and quantity
sChildPart = cl.Offset(0, 3).Value

'Presumably there are no duplicat part numbers in the child list, but
'if so, uncomment the IF blocking below
' If Not bItemExists(sChildPartList, _
' sParentWH & "-" & sParentPart & "-" & sChildPart) Then
' 'Child not in array so add to string and add node
' sChildPartList = sChildPartList & "," & sParentWH & _
' "-" & sParentPart & "-" & sChildPart

.Add relative:=sParentWH & "-" & sParentPart, _
relationship:=tvwChild, _
Key:=sParentWH & "-" & sParentPart & "-" & sChildPart, _
Text:=sChildPart
.Add relative:=sParentWH & "-" & sParentPart & "-" & sChildPart, _
relationship:=tvwChild, _
Key:=sParentWH & "-" & sParentPart & "-" & sChildPart & "-Quantity", _
Text:="Quantity= " & cl.Offset(0, 4).Value
' End If


Next cl
End With
End Sub

Private Function bItemExists(sItems As String, sLookFor As String) As Boolean
'Purpose: Check if item already exists in list
Dim lElements As Long
Dim aryItems() As String

'Split existing parents into string
aryItems = Split(sItems, ",")

For lElements = LBound(aryItems) To UBound(aryItems)
If aryItems(lElements) = sLookFor Then
'Item exists
bItemExists = True
Exit Function
End If
Next lElements

End Function

stapuff
07-12-2007, 03:45 PM
Ken -

South of - I lived on an island off the Coast of Washington State.

I was wrong - it is all the whse's that are exclusively numbers 05,07,09,11,12,13, etc.

The code fails at the last line (****):


For Each cl In Worksheets("Prod_Struct").Range("A3:A20000")
'Add parent WH if necessary
If cl.Value = sParentWH Then
'same parent, ignore
Else
sParentWH = cl.Value
**** .Add Key:=sParentWH, Text:=sParentWH


As far as the "set it so that the node is only added if it's value meets the sParentWH value in the textbox" - I had tried everything I knew to get it to work.

Again -

Thanks for your time.

Kurt

Ken Puls
07-12-2007, 03:50 PM
South of - I lived on an island off the Coast of Washington State.
Ah! LOL!


I was wrong - it is all the whse's that are exclusively numbers 05,07,09,11,12,13, etc.

Okay, let's try forcing those numbers to be strings then...


For Each cl In Worksheets("Prod_Struct").Range("A3:A20000")
'Add parent WH if necessary
If CStr(cl.Value) = sParentWH Then
'same parent, ignore
Else
sParentWH = CStr(cl.Value)
.Add Key:=sParentWH, Text:=sParentWH



As far as the "set it so that the node is only added if it's value meets the sParentWH value in the textbox" - I had tried everything I knew to get it to work.
Let's come back to this one once we've got the above to work. :)

stapuff
07-12-2007, 04:50 PM
Ken -

Failed in the same spot.

Your thoughts................

stapuff
07-12-2007, 08:15 PM
Ken -

"This is a variant of the above that will work if the list is out of order. It might take a little longer to run, as it has to evaluate if each item has already been added to the tree, but may solve the issue you have above as well:"

The code took a lot longer to run and it still failed at the same place.

I sending you more data to work with. Some that has worked and some where it has failed.

What are your thoughts..........

Thanks

Kurt

stapuff
07-15-2007, 05:42 AM
Ken -


A quick update...

I change the data on sheets("Prod_Struct"). If the Whse was a number 05,07,09, etc. I put an ' in front of it. Your code then worked for all with no problems. It appears the the treeview has issues with numbers as a parent.

Thanks,

Kurt

Ken Puls
08-10-2007, 09:33 PM
Hi Kurt,

Sorry for the late reply here. Things have kept me very busy. I'm glad you got it working.

An interesting point you make there. I guess it might be worth wrapping each node value in CStr() to make sure it comes out as text.

Eg:
sParentWH = CStr(cl.Value)

And then
If CStr(cl.Value) = sParentWH

The CStr converts the value into a string, so you should be able to avoid the issue of having to put a ' in front.