Org Chart from data with level numbers

[Erwin65456]

Yes, it is finally here, but it is not perfect. looking for someone very clever to make it perfect.

Credit goes to: Generate organization chart in excel

below is the code to make an organisational chart from spreadsheet.

firstly, the picture below show you the data which you need to process into the chart.
Column A: literally just sequential numbering (this informs the code as to what order people will fall under other people)
Column B: the text that you want to display in the org chart boxes
Column C: the organisational level (1 = top of the food chain, 2 reports to 1, 3 will report to 'the specific 2' that it is directly below in the list of data you supply etc.)

Ther problem: after running this code, the org chart that appears is image 2. with the chart selected this needs to be changed to the chart in image 3 (top left selection) which leaves you with the correct chart in image 4.

please shed light on how to edit the code so that the code populates to the correct chart as in image 4, instead of having to change the format after running the code.

the code:

Sub org()
'
' org Macro
' Macro to generate organization chart
'
' Keyboard Shortcut: Ctrl+j
'
    Dim ogSALayout As SmartArtLayout
    Dim QNode As SmartArtNode
    Dim QNodes As SmartArtNodes
    Dim t As Integer
    Set ogSALayout = Application.SmartArtLayouts(92) 'reference to organization chart
    Set ogShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(ogSALayout)
    Set QNodes = ogShp.SmartArt.AllNodes
    t = QNodes.Count
  
    While QNodes.Count < t
    QNodes(QNodes.Count).Delete
    Wend
  
    While QNodes.Count < Range("A1").End(xlDown).Row
    QNodes.Add.Promote
    Wend
  
    For i = 1 To Range("A1").End(xlDown).Row
    'Promote and demote nodes to put them at the proper level.

    While QNodes(Range("A" & i)).Level < Range("C" & i).Value
        QNodes(Range("A" & i)).Demote
    Wend
 
    'Copy the cell text to the node.
    QNodes(Range("A" & i)).TextFrame2.TextRange.Text = Range("B" & i)
    Next i
End Sub

 

[Worf]

See if you can use this one:

Organization chart with VBA – Part 2

 

[mj4345]

Yes, it is finally here, but it is not perfect. looking for someone very clever to make it perfect.

Credit goes to: Generate organization chart in excel

below is the code to make an organisational chart from spreadsheet.

firstly, the picture below show you the data which you need to process into the chart.
Column A: literally just sequential numbering (this informs the code as to what order people will fall under other people)
Column B: the text that you want to display in the org chart boxes
Column C: the organisational level (1 = top of the food chain, 2 reports to 1, 3 will report to 'the specific 2' that it is directly below in the list of data you supply etc.)

Ther problem: after running this code, the org chart that appears is image 2. with the chart selected this needs to be changed to the chart in image 3 (top left selection) which leaves you with the correct chart in image 4.

please shed light on how to edit the code so that the code populates to the correct chart as in image 4, instead of having to change the format after running the code.

the code:

Sub org()
'
' org Macro
' Macro to generate organization chart
'
' Keyboard Shortcut: Ctrl+j
'
    Dim ogSALayout As SmartArtLayout
    Dim QNode As SmartArtNode
    Dim QNodes As SmartArtNodes
    Dim t As Integer
    Set ogSALayout = Application.SmartArtLayouts(92) 'reference to organization chart
    Set ogShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(ogSALayout)
    Set QNodes = ogShp.SmartArt.AllNodes
    t = QNodes.Count
 
    While QNodes.Count < t
    QNodes(QNodes.Count).Delete
    Wend
 
    While QNodes.Count < Range("A1").End(xlDown).Row
    QNodes.Add.Promote
    Wend
 
    For i = 1 To Range("A1").End(xlDown).Row
    'Promote and demote nodes to put them at the proper level.

    While QNodes(Range("A" & i)).Level < Range("C" & i).Value
        QNodes(Range("A" & i)).Demote
    Wend
 
    'Copy the cell text to the node.
    QNodes(Range("A" & i)).TextFrame2.TextRange.Text = Range("B" & i)
    Next i
End Sub

Great code - did you find a fix for this?

 

[elbeau]

Yes, it is finally here, but it is not perfect. looking for someone very clever to make it perfect.

Credit goes to: Generate organization chart in excel

please shed light on how to edit the code so that the code populates to the correct chart as in image 4, instead of having to change the format after running the code.

the code:

    Set ogSALayout = Application.SmartArtLayouts(88) 'reference to organization chart '(See HansV post [URL]https://eileenslounge.com/viewtopic.php?t=23960[/URL])

Great code - did you find a fix for this?

I had the same issue & found a post in another forum to identify the ID # of the org chart styles.
For the OP, change 92 to 88 for the SmartArtLayouts style you requested.

4​	hierarchy	Lined List
34​	hierarchy	Hierarchy List
36​	hierarchy	Table Hierarchy
88​	hierarchy	Organization Chart
89​	hierarchy	Name and Title Organization Chart
90​	hierarchy	Half Circle Organization Chart
91​	hierarchy	Circle Picture Hierarchy
92​	hierarchy	Hierarchy
93​	hierarchy	Labeled Hierarchy
94​	hierarchy	Horizontal Organization Chart
95​	hierarchy	Horizontal Multi-Level Hierarchy
96​	hierarchy	Horizontal Hierarchy
97​	hierarchy	Horizontal Labeled Hierarchy