Need a way to create org chart in excel from data list of emp and manager.

[kuldeepjainesl]

I need a way to make org chart in excel like we make in visio using shapes. i am attaching the sample file. There can be number of small group in this list. First coloum is for emp and second coloum is for manager. I tried using the smart art but it does not support and via chart it do not seems to be possible.

There may be sevrel isolated group in the data and to be plotted separately if needed. Like we have 40 team and all 40 teams data is available in one table and we need the org chart for all 40 teams. Any help or idea to move ahead will help.

 

[kuldeepjainesl]

Org chart = Organization Chart and data is presented to show employee for easy understanding however this is going to be used in a complex network analysis where long routes to reach host create problems.

 

[Chihiro]

Try this add-in. Haven't tested it myself though.
https://sites.google.com/site/beyondexcel/project-updates/freeorgchartaddin

 

[kuldeepjainesl]

Out of the world.... Just Wow...This is what i intended to get. Thanks a lot.

However i just need one more help in moving ahead with this solution.

Now we have the org chart. it is possible to search and highlight few employee available in a separate coloum? For example we say that in coloum Z we have random 20 names (i will use named range for this) which may appear somewhere in chart. Highlight those without searching one by one.

One exception, May be few name are not available in chart so we will omit those and will highlight only which we can find. A piece of code i want to embed in this addin file via a module that will be will run when needed.

Apart from this help, i am thankful to you for sharing the website, it has lot of valuable stuff that is really helpful.

Thanks in advance

 

[Chihiro]

Here's sample of how to do this.

The add-in uses AutoShape to generate Org Chart.

Sub Test()
Dim c As Variant
Dim mShape As Shape
Dim rCell As Range
Dim findString As String

For Each mShape In Worksheets("Sheet1").Shapes 'Change sheet as needed
    If mShape.AutoShapeType = msoShapeRoundedRectangle Then
        findString = Trim(Replace(mShape.TextFrame.Characters.Text, Chr(10), ""))
        For Each rCell In Range("lstName") 'Change Named Range as needed
            With rCell
                Set c = .Find(findString, LookIn:=xlValues, LookAt:=xlWhole)
                If Not c Is Nothing Then
                    mShape.Fill.ForeColor.RGB = RGB(255, 255, 0) 'Change color code as needed
                End If
            End With
        Next rCell
    End If
Next mShape
End Sub

 

[kuldeepjainesl]

i could understand the approach but it is not working as i think the round rectangle is not found. the node has name like this "Node:Emp9" where emp 9 is the text inside the shape. we need to pick the node and check text to highlight if available in named range.

i got a code from craig that is working for highlighting shape dynamically on selection. you can get the shape selection clue.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static oLastCell As Range
'  Reset color
    If Not oLastCell Is Nothing Then
        wksDemo.Shapes("Node:" & oLastCell).ShapeStyle = 39
    End If
'  Highligh Color
    If Not Intersect(Target, [tblBOM]) Is Nothing Then
        wksDemo.Shapes("Node:" & Target).ShapeStyle = 40
        Set oLastCell = Target
    End If
End Sub

 

[Chihiro]

I'm not sure I understand you.
The add-in by default uses -2 type & 5 type. -2 being connector and 5 being rounded rectangle.

But then, I didn't look deep in the code. So there may be option to change. If so, just loop through the shapes and find the appropriate type.

 

[kuldeepjainesl]

OK Chihiro, Thanks for your help. it has been great to get the solution working up to this stage.

However trying to explain in case it trigger something.

You have used the line in your code to find the shape

If mShape.AutoShapeType = msoShapeRoundedRectangle Then

and the upper given code is using one of the below code to find and act.

wksDemo.Shapes("Node:" & Target).ShapeStyle = 40

wksDemo.Shapes("Node:" & oLastCell).ShapeStyle = 39

if we can get the lower method in your code. we are done