How to Create Organization chart in Excel?
Do you want to do add Org Chart thru this menu option?
Click on Excel Menu -> Insert -> Smart Art. Choose Hierarchy charts in pop up menu.
Select the Org charts of your choice & enter each level of chart. There is more detailed explanation for manual creation of Org chart in this page.
Or like this …
Automatic: What if you want a customized automatic table to understand the flow of control?
Excel VBA Code – Build Org Chart – Hierarchy Flow
Do you already have a Organization Reporting structure as in Table-1?
Then create Org chart or Hierarchy Tree using these steps.
Table-1:
| Employee 1 | Employee 2 |
| Employee 1 | Employee 3 |
| Employee 2 | Employee 4 |
| Employee 3 | Employee 7 |
| Employee 2 | Employee 8 |
| Employee 2 | Employee 9 |
| Employee 4 | Employee 5 |
| Employee 4 | Employee 6 |
| Employee 5 | Employee 10 |
- Create a empty blank workbook with 3 sheets. Copy paste the Org reporting details in Sheet1 like this:
- Press Alt + F11. Insert a new module.
- Copy paste the VBA code in this page to the VBA project.
Press F5 to get the Hierarchy Table in Sheet3.
VBA Code to build Hierarchy Table
Here is the code that is worth a shot.
It does not create any graphical representation.
Instead it splits the table-1 as per the level of control & present a table format that is almost like a horizontal organizational hierarchy chart.
'--------------------------------------------------------------------------------
'Code by author@officetricks.com (or) kumarapush777 (Fiverr)
'Visit https://officetricks.com to get more Free & Fully Functional VBA Codes
'--------------------------------------------------------------------------------
'Build Organization Chart from Reporting Hierarchy Table
Sub Build_Hierarchy_Officetricks()
Dim iSh As Worksheet, oSh As Worksheet, hSh As Worksheet
Dim iRow As Double, oRow As Double, hRow As Double
Dim iCol As Double, oCol As Double, hCol As Double
Dim iParent As String, iChild As String
Dim oNode As String, bParentFound As Boolean, bChildFound As Boolean
Dim cParent As Range, cChild As Range, hLevel As Double, cHierarchy As Range
'Assign Cell Values
Set iSh = ThisWorkbook.Sheets(1)
Set oSh = ThisWorkbook.Sheets(2)
oSh.Activate
oSh.Cells.ClearContents
'Find Ranking Number for Each Node
'Loop Thru Each Cell
iRow = 1
While iSh.Cells(iRow, 1) <> ""
iParent = iSh.Cells(iRow, 1)
iChild = iSh.Cells(iRow, 2)
oRow = 1
bParentFound = False
bChildFound = False
Do While oSh.Cells(oRow, 1) <> ""
oNode = oSh.Cells(oRow, 1)
If VBA.Trim(VBA.UCase(oNode)) = VBA.Trim(VBA.UCase(iParent)) Then
bParentFound = True
Set cParent = oSh.Cells(oRow, 1)
Else
If VBA.Trim(VBA.UCase(oNode)) = VBA.Trim(VBA.UCase(iChild)) Then
bChildFound = True
Set cChild = oSh.Cells(oRow, 1)
End If
End If
If bParentFound And bChildFound Then
Exit Do
End If
oRow = oRow + 1
Loop
If bParentFound = False Then
While oSh.Cells(oRow, 1) <> ""
oRow = oRow + 1
Wend
oSh.Cells(oRow, 1) = iParent
oSh.Cells(oRow, 2) = 0
Set cParent = oSh.Cells(oRow, 1)
End If
If bChildFound = False Then
While oSh.Cells(oRow, 1) <> ""
oRow = oRow + 1
Wend
oSh.Cells(oRow, 1) = iChild
Set cChild = oSh.Cells(oRow, 1)
End If
oSh.Cells(cChild.Row, 2).Formula = "=1+" & oSh.Cells(cParent.Row, 2).Address
oSh.Columns.AutoFit
iRow = iRow + 1
Wend
'Sort Nodes Based on its Ranking
oSh.Sort.SortFields.Clear
oSh.Sort.SortFields.Add Key:=Range("B1:B" & oRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With oSh.Sort
.SetRange Range("A1:B" & oRow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Build Hierarchy Chart Table or Organization Chart
'Place Each Node in its Hierarchy Level
Set hSh = ThisWorkbook.Sheets(3)
hSh.Activate
hSh.Cells.ClearContents
oRow = 1
hRow = 1
Do While oSh.Cells(oRow, 1) <> ""
oNode = oSh.Cells(oRow, 1)
hLevel = oSh.Cells(oRow, 2) + 2
Set cHierarchy = Find_First_In_Range(oNode, hSh.Cells)
If cHierarchy Is Nothing Then
hSh.Cells(hRow, hLevel) = oSh.Cells(oRow, 1)
hSh.Cells(hRow, 1) = "."
Else
hRow = cHierarchy.Row
End If
iRow = 1
Do While iSh.Cells(iRow, 1) <> ""
iParent = iSh.Cells(iRow, 1)
iChild = iSh.Cells(iRow, 2)
If iParent = oNode Then
hRow = hRow + 1
hSh.Rows(hRow & ":" & hRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
hSh.Cells(hRow, hLevel + 1) = iChild
hSh.Cells(hRow, 1) = "."
End If
iRow = iRow + 1
Loop
oRow = oRow + 1
Loop
hSh.Columns.AutoFit
'Process Completed
MsgBox "Process Completed"
End Sub
Function Find_First_In_Range(FindString As String, iRng As Range) As Range
Dim Rng As Range
If Trim(FindString) <> "" Then
With iRng
Set Rng = .Find(What:=FindString, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
End If
Set Find_First_In_Range = Rng
End Function
This code creates this Org table in 2 steps.
- In first Step it decides the ranking for each employee & building a ranking table.
- Then based on that ranking table, the position of each Employee is decided.
The resulting table structure will look almost like a tree, easy to understand the flow on control & who is reporting to whom.
Also, this can be improvised further to color the background cells of nodes as per their position or control ranking.
