Running Private Sub

[StuartWhi]

Hi Experts,

After checking the forum I found what appears to be perfect for my needs but not able to get this VBA private sub to run (or it's simply not doing anything that I can see).

I have taken the code from this post (I'm using Excel 2010),

My set-up is as follows,

Open new Excel (Book1),
Paste below data (taken from above post) in "Sheet1"

Excel 2010

	A	B	C	D	E	F
Not sure	Current Node ID	Parent node ID	Not sure	Not sure	Persons Name
A00	USCR00O0A02J	USCR00O0A02J	Ústavní soud
A00	USCR00O0A03E	USCR00O0A02J	Justice
A00	USCR00O0A049	USCR00O0A02J	Generální sekretár
A00	USCR00O0A054	USCR00O0A02J	Soudní správa
A00	USCR00O0A06Z	USCR00O0A03E	1. senát
A00	USCR00O0A07U	USCR00O0A03E	2. senát
A00	USCR00O0A08P	USCR00O0A03E	3. senát
A00	USCR00O0A09K	USCR00O0A03E	4. senát
A00	USCR00O0A0AF	USCR00O0A03E	Funkcionár
A00	USCR00O0A0Q7	USCR00O0A049	Generální sekretár
A00	USCR00O0A0SX	USCR00O0A049	Analytický odbor

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]

[TD="align: center"]3[/TD]

[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]

[TD="align: center"]4[/TD]

[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]

[TD="align: center"]5[/TD]

[TD="align: right"]3[/TD]
[TD="align: right"]3[/TD]

[TD="align: center"]6[/TD]

[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]

[TD="align: center"]7[/TD]

[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]

[TD="align: center"]8[/TD]

[TD="align: right"]3[/TD]
[TD="align: right"]3[/TD]

[TD="align: center"]9[/TD]

[TD="align: right"]4[/TD]
[TD="align: right"]4[/TD]

[TD="align: center"]10[/TD]

[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]

[TD="align: center"]11[/TD]

[TD="align: right"]1[/TD]
[TD="align: right"]20[/TD]

[TD="align: center"]12[/TD]

[TD="align: right"]2[/TD]
[TD="align: right"]30[/TD]

</tbody>

Sheet1​

Delete the top row and left column (to remove the inserted column and rows),
Right click "Sheet1" tab, select "View Code",
Paste the below code,

'Source is current open worksheet,'Source = ThisWorkbook.Sheets '(name of the current list)
Private Sub CreateDiagram(Source As Worksheet)


    Dim oSALayout As SmartArtLayout
    Dim QNode As SmartArtNode
    Dim QNodes As SmartArtNodes
    Dim Line As Integer
    Dim PID As String      'identification of parent node
    
    Set oSALayout = Application.SmartArtLayouts(92) 'reference to organization chart
    Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout)
    
    Set QNodes = oShp.SmartArt.AllNodes
    For i = 1 To 5      'delete all included nodes
        oShp.SmartArt.AllNodes(1).Delete
    Next
    
    'looking for root(s)
    Line = 2
    Do While Source.Cells(Line, 1) <> ""
        If Source.Cells(Line, 2) = Source.Cells(Line, 3) Then
            Set QNode = oShp.SmartArt.AllNodes.Add
            QNode.TextFrame2.TextRange.Text = Source.Cells(Line, 6)
            PID = Source.Cells(Line, 2)
            Source.Rows(Line).Delete
            Call AddChildNodes(QNode, Source, PID)
        Else
            Line = Line + 1
        End If
    Loop


End Sub
Private Sub AddChildNodes(QNode As SmartArtNode, Source As Worksheet, PID As String)
    Dim Line As Integer
    Dim Found As Boolean
    Dim ParNode As SmartArtNode
    Dim CurPid As String 'ID of current parent node
    
    Line = 2
    Found = False    'nothing found yet
    Do While Source.Cells(Line, 1) <> ""
        If Source.Cells(Line, 3) = PID Then
            Set ParNode = QNode
            Set QNode = QNode.AddNode(msoSmartArtNodeBelow)
            QNode.TextFrame2.TextRange.Text = Cells(Line, 6)
            CurPid = Source.Cells(Line, 2)
            If Not Found Then Found = True 'something was find
            Source.Rows(Line).Delete
            Call AddChildNodes(QNode, Source, CurPid)
            Set QNode = ParNode
        ElseIf Found Then    'it's sorted,so nothing else can be found
            Exit Do
        Else
            Line = Line + 1
        End If
    Loop
    
End Sub

Nothing happens in Sheet1?
I have adjusted the data in cell C12 but still nothing happens?

Sorry for what I guess in a simple and most likely silly question but I must have missed something very basic in this case.

Thanks for your help in advance as this simple thing is driving me mad.

Regards,

Stuart.

 

[HaHoBe]

Hi, Stuart.

you must apply another macro to start passing the parameter for Worksheet, i.e.

Sub StartMacro()
CreateDiagram(ActiveSheet) 'for the active sheet
End Sub

Ciao,
Holger

 

[StuartWhi]

Hi Holger,

Thanks for your help on this unfortunately I'm still stuck... I don’t expect you to fault find some else code but I’m not an expert obviously (basically able to combine/adjust existing running code only).
Do you (or anyone else) have any idea why when running this I end up with the following error,
“Object doesn’t support this property or method”
When stepping through the code “F8” it doesn’t help, when it tries to run “CreateDiagram” I get this error, when looking up excel help it doesn’t help…

Below is the code I have (the full CreateDiagram code is in the earlier post).

Sub StartMacro()
CreateDiagram (ActiveSheet) 'for the active sheet
End Sub
'Source is current open worksheet,
'Source = ThisWorkbook.Sheets '(name of the current list)
Private Sub CreateDiagram(Source As Worksheet)


    Dim oSALayout As SmartArtLayout

Look forward to any thoughts on this.

Thanks in advance for anyone’s ideas.

Stuart.

 

[VoG]

Try

Call CreateDiagram(ActiveSheet)

 

[StuartWhi]

Hi VoG (and Holger),

Thanks for this I thought it was the same thing but adding "Call" fixed the issue.

The code isn't perfect for my needs but I'm able to work with it now.

As always, I’m amazed with how responsive and helpful this community is, great stuff in indeed.

Thanks both.

Stuart.

 

[shg]

Sub x()
    Call y(ActiveSheet) ' works
    y ActiveSheet       ' works
    y (ActiveSheet)     ' fails
End Sub

Sub y(wks As Worksheet)
    wks.Range("A1").Value = "test"
End Sub

The third call fails because the parens around the argument attempt to pass the worksheet object by value.

 

[HaHoBe]

Hi, shg,

thanks for your explanation - should have tested it before posting.

Ciao,
Holger