VBA Ebene in SmartArt Hierarchie zutun

Hallo,

ich bräuchte Hilfe, um für die folgenden aus Smart Arts bestehenden Hierarchie eine weitere Reihe ganz unten hinzuzufügen, von der man die Werte in Spalte D einträgt.
Die Beispielmappe ist angehängt: https://www.herber.de/bbs/user/158281.xlsm

Option Explicit

Sub CreateTree()
    Dim w As Worksheet
    Dim a As Variant
    Dim i As Long
    Dim m As Long
    Dim cat As String
    Dim subcat As String
    Dim subsubcat As String
    Dim t As SmartArt
    Dim r As SmartArtNode
    Dim c As SmartArtNode
    Dim sc As SmartArtNode
    Dim ssc As SmartArtNode
    Set w = ActiveSheet
    Set t = w.Shapes("Diagram 1").SmartArt
    Do While t.Nodes.Count
        t.Nodes(1).Delete
    Loop
    Set r = t.Nodes.Add
    r.TextFrame2.TextRange.Text = "Root"
    m = w.Range("A1").End(xlDown).Row
    a = w.Range("A1:C" & m).Value
    i = 2
    Do
        cat = a(i, 1)
        Set c = r.AddNode(msoSmartArtNodeBelow)
        c.TextFrame2.TextRange.Text = cat
        Do
            subcat = a(i, 2)
            Set sc = c.AddNode(msoSmartArtNodeBelow)
            sc.TextFrame2.TextRange.Text = subcat
            Do
                subsubcat = a(i, 3)
                Set ssc = sc.AddNode(msoSmartArtNodeBelow)
                ssc.TextFrame2.TextRange.Text = subsubcat
                i = i + 1
                If i > m Then GoTo ExitHere
            Loop Until a(i, 2) > subcat Or a(i, 1) > cat
        Loop Until a(i, 1) > cat
    Loop
ExitHere:
End Sub