Org Chart from data with level numbers

Erwin65456

New Member
Joined
Dec 19, 2020
Messages
8
Office Version
  1. 365
Platform
  1. Windows
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:

VBA 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
 

Attachments

  • Screenshot (22).png
    Screenshot (22).png
    29.3 KB · Views: 233
  • Screenshot (26).png
    Screenshot (26).png
    138.3 KB · Views: 207
  • Screenshot (27).png
    Screenshot (27).png
    126.8 KB · Views: 226
  • Screenshot (28).png
    Screenshot (28).png
    75.4 KB · Views: 232

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
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:

VBA 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?
 
Upvote 0
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:

VBA 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​
hierarchyLined List
34​
hierarchyHierarchy List
36​
hierarchyTable Hierarchy
88​
hierarchyOrganization Chart
89​
hierarchyName and Title Organization Chart
90​
hierarchyHalf Circle Organization Chart
91​
hierarchyCircle Picture Hierarchy
92​
hierarchyHierarchy
93​
hierarchyLabeled Hierarchy
94​
hierarchyHorizontal Organization Chart
95​
hierarchyHorizontal Multi-Level Hierarchy
96​
hierarchyHorizontal Hierarchy
97​
hierarchyHorizontal Labeled Hierarchy
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,167
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top