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: 14
  • Screenshot (26).png
    Screenshot (26).png
    138.3 KB · Views: 12
  • Screenshot (27).png
    Screenshot (27).png
    126.8 KB · Views: 14
  • Screenshot (28).png
    Screenshot (28).png
    75.4 KB · Views: 12

Some videos you may like

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Watch MrExcel Video

Forum statistics

Threads
1,122,364
Messages
5,595,722
Members
414,013
Latest member
tnobbs

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
Top