Adjusting Treeview Code

[stapuff]

I have an example of the use of a Userform Treeview (author is unknown) that I would like help adjusting.


In sheet 1 are the following columns:

A = Name
B = Parent
C = Avatar
D = Description
E = Image Controls (with different images in each cell).

I would like to modify the following code to get rid of the use of Avatar and Image Controls while adding a column for unit of measure.

A = Name
B = Parent
C = Description
D = UOM


The following is the code I would like to modify:

Sheet Code

Option Explicit

Private Sub CommandButton1_Click()
    UserForm1.Show
End Sub

Userform1 Code

Option Explicit

Private Sub UserForm_Activate()
    SettingImageList
    MakeFamilyTree
End Sub

Private Sub SettingImageList()
    Dim myImgList As New ImageList
    Dim bt
    With myImgList.ListImages
        .Add Key:="Image1", Picture:=Sheet1.Image1.Picture
        .Add Key:="Image2", Picture:=Sheet1.Image2.Picture
        .Add Key:="Image3", Picture:=Sheet1.Image3.Picture
        .Add Key:="Image4", Picture:=Sheet1.Image4.Picture
        .Add Key:="Image5", Picture:=Sheet1.Image5.Picture
        .Add Key:="Image6", Picture:=Sheet1.Image6.Picture
        .Add Key:="Image7", Picture:=Sheet1.Image7.Picture
        .Add Key:="Image8", Picture:=Sheet1.Image8.Picture
        .Add Key:="Image9", Picture:=Sheet1.Image9.Picture
        .Add Key:="none", Picture:=Sheet1.none.Picture
    End With
    With TreeView1
        Set .ImageList = myImgList
        .Indentation = 14
        .LabelEdit = tvwManual
        .HideSelection = False
    End With
End Sub

Private Sub TreeView1_NodeClick(ByVal node As MSComctlLib.node)
    Me.TextBox1.Text = node.Text
    Me.TextBox2.Text = GetInfo(node.Text, False)
End Sub

Module1 Code

Option Explicit

Sub MakeFamilyTree()
    Dim arrName As Variant
    Dim arrParent As Variant
    Dim arrMatrix() As Variant
    Dim arrTemp As Variant
    Dim elm As Variant
    Dim i As Long, j As Long
    Dim ret As Variant
    Dim node As node
    Dim bExists As Boolean

    'Reset Tree View control
    UserForm1.TreeView1.Nodes.Clear
    
    'Get data from the worksheet as an array
    With Sheets("Sheet1").Range(Sheets("Sheet1").[A2], Sheets("Sheet1").[A65536].End(xlUp))
        arrName = .Value
        arrParent = .Offset(, 1).Value
    End With
    
    'Sorting in an array
    ReDim arrMatrix(1 To UBound(arrName), 1 To 1)
    For Each elm In arrParent
        i = i + 1
        ret = Application.Match(elm, arrName, 0)
        If IsError(ret) Then
            arrMatrix(i, 1) = arrName(i, 1)
        Else
            j = 3
            ReDim Preserve arrMatrix(1 To UBound(arrMatrix), 1 To j)
            arrMatrix(i, 1) = arrName(i, 1)
            arrMatrix(i, 2) = elm
            arrMatrix(i, 3) = arrParent(ret, 1)
            Do
                ret = Application.Match(arrParent(ret, 1), arrName, 0)
                If IsError(ret) Then Exit Do
                If arrParent(ret, 1) = "" Then Exit Do
                j = j + 1
                ReDim Preserve arrMatrix(1 To UBound(arrMatrix), 1 To j)
                arrMatrix(i, j) = arrParent(ret, 1)
            Loop
        End If
    Next
    arrTemp = CustomTranspose(arrMatrix)
    
    'Let's add each data to nodes
    For i = 1 To UBound(arrTemp)
        For j = 1 To UBound(arrTemp, 2)
            If Not IsEmpty(arrTemp(i, j)) Then
                With UserForm1.TreeView1
                    bExists = False
                    For Each elm In .Nodes
                        If elm = arrTemp(i, j) Then bExists = True
                    Next
                    If Not bExists Then
                        If j = 1 Then
                            Set node = .Nodes.Add(, , arrTemp(i, j), arrTemp(i, j), _
                            Image:=GetInfo(arrTemp(i, j), True))
                        Else
                            Set node = .Nodes.Add(arrTemp(i, j - 1), tvwChild, arrTemp(i, j), arrTemp(i, j), _
                            Image:=GetInfo(arrTemp(i, j), True))
                        End If
                        node.Expanded = True
                    End If
                End With
            End If
        Next
    Next
End Sub

Function CustomTranspose(ByVal buf As Variant) As Variant
'Transpose an order of an array from Parent to Child
    Dim arrTemp() As Variant
    Dim i As Long, j As Long, k As Long
    ReDim arrTemp(LBound(buf) To UBound(buf), LBound(buf, 2) To UBound(buf, 2))
    For i = 1 To UBound(buf)
        k = 0
        For j = UBound(buf, 2) To 1 Step -1
            If Not IsEmpty(buf(i, j)) Then
                k = k + 1
                arrTemp(i, k) = buf(i, j)
            End If
        Next
    Next
    CustomTranspose = arrTemp
End Function

Function GetInfo(sName, bAorD) As String
'Returns appropreate image
    Dim rFound As Range
    Set rFound = Sheet1.Columns(1).Find(sName, lookat:=xlWhole)
    If rFound Is Nothing Then
        GetInfo = "none"
    Else
        GetInfo = IIf(bAorD, rFound.Offset(, 2).Value, rFound.Offset(, 3).Value)
    End If
End Function

I have tried to comment out everything I thought would allow this to happen, however, I get an error requesting the images.

Any help would be greatly appreciated.

Thanks,

Kurt