Build Excel Organization Chart – Hierarchy Tree – From Data

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: 

• 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.