Setting up Tree Structure

I receive a weekly spreadsheet with about 20K names. For each name there about 20 columns of information such as Position#, Employee #, Position Function, Job Title, etc. I have to pare this down to send a report to about 30 different Program Directors in 11 different Regions showing who's supervising which caseworkers and how many hours their Caseworkers are using. Caseworker, Program Director, and Supervisor may or may not be in the Position Function or the Job Title, so I can't rely on that. All I can really rely on is the "who reports to whom" column.

The attached example is a way-pared down version of my weekly report. There's a Names column, an Employee ID column, an Hours Worked column, and a Reports to column. I need a macro or a formula that will tell me who works for whom. Ideally it will sort out like this (though there may be in some cases 5 or 6 levels instead of the 3 shown below):

Big boss →Midlevel → Caseworker - hours worked

So results will be something like:

Frankenstein → 	Plato 	→ Sigmund Freud - hours worked
                               → Willey Mays - hours worked
         →          Elvis	→ Mother Teresa - hours worked
                               → Paul McCartney - hours worked

So I can create a report to send to Frankenstein showing him that Sigmund and Willey, who are under Plato's supervision, worked umpteen hours each. I'll work out how to paste the data in the format I need, but I need to know how to sort the data to get the structure reflected above.

Any help getting me started would be greatly appreciated.

How about something like this?

How about this... From smaller boss to bigger:

Try this:

code removed...see below

Here's another try. I will expand every boss branch fully using recursion. Run the macro BuildEmployeetree. Tree Structure.xls

Wow...ONE little letter makes all the difference:

            .Range("C:C").AutoFilter Field:=1, Criteria1:=emp2Arr(Emp2Name)

Here's the corrected code:

Option Explicit

Sub CreateTree()
'JBeaucaire   3/4/2010
'Create a tree structure showing 4 levels of employee reporting
Dim wsTree As Worksheet, wsData As Worksheet
Dim empArr As Variant, emp2Arr As Variant
Dim LR As Long, NR As Long, eRow As Long, EmpName As Long, Emp2Name As Long
Application.ScreenUpdating = False

Set wsData = Sheets("Sheet1")
Set wsTree = Sheets("Sheet2")
NR = 1

With wsData
    .Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("H1"), Unique:=True
    LR = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H2:H" & LR).Sort Key1:=.Range("H2"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    .Range("I2").FormulaR1C1 = "=COUNTIF(C1,RC8)"
    .Range("I2").AutoFill Destination:=.Range("I2:I" & LR)
    eRow = .Range("I:I").Find(0, After:=.[I1], LookIn:=xlValues, LookAt:=xlWhole, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row

    .Range("H" & eRow).Copy wsTree.Range("A" & NR)

    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("C:C").AutoFilter Field:=1, Criteria1:=Range("H" & eRow)
    .Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).Copy wsTree.Range("AA1")
    LR = wsTree.Range("AA" & Rows.Count).End(xlUp).Row
    empArr = Application.WorksheetFunction.Transpose(wsTree.Range("AA1:AA" & LR).Value2)
    wsTree.Range("AA1:AA" & LR).ClearContents
    .Range("C:C").AutoFilter Field:=1
    .Range("H:I").ClearContents

    For EmpName = 1 To UBound(empArr)
        wsTree.Range("B" & NR).Value = empArr(EmpName)
        .Range("C:C").AutoFilter Field:=1, Criteria1:=empArr(EmpName)
        .Range("A2:A" & .Rows.Count).SpecialCells(xlCellTypeVisible).Copy wsTree.Range("AA1")
        LR = wsTree.Range("AA" & Rows.Count).End(xlUp).Row
        emp2Arr = Application.WorksheetFunction.Transpose(wsTree.Range("AA1:AA" & LR).Value2)
        wsTree.Range("AA1:AA" & LR).ClearContents
        For Emp2Name = 1 To UBound(emp2Arr)
            wsTree.Range("C" & NR) = emp2Arr(Emp2Name)
            .Range("C:C").AutoFilter Field:=1, Criteria1:=emp2Arr(Emp2Name)
            .Range("A2:A" & .Rows.Count).SpecialCells(xlCellTypeVisible).Copy wsTree.Range("D" & NR)
            NR = wsTree.Range("D" & Rows.Count).End(xlUp).Row + 1
        Next Emp2Name
    Next EmpName

End With

wsData.AutoFilterMode = False
wsTree.Activate
Cells.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Actually, my solution produced boss/employee trees for all bosses. You will see that Thomas Edison has his one tree, while the Abaddon contains everybody. It depends on how you want to represent the relationships. If you like what JBeaucaire did, go with it!

You had a followup question? Post a sample data set here of the new requirements and we'll take a look.

Your new sample data differs from the other in a significant way.

The original data had multiple people that reported to your main person, "Abaddon". All of the people that reported to Abbadon had people reporting to them, and all the people in the list flowed through that secondary list.

In your new data set, "God" is the main person, but only 1 person reports to God. So I tweaked the one error that didn't properly create an array with only 1 item in it, but that only resolved the issue for the one person reporting to God, we DO get that list now. But since no one else reports to God, no other subtrees are created. The tree dies.

That means most of your people are left un-treed.

For the tree to work properly, you need to be able to pick ANY person in column A and follow their "reports to" person sequentially until you run into God within 4 steps.

Here's the tweaked macro so you can run it on your data to see what I mean.

Option Explicit

Sub CreateTree()
'JBeaucaire   3/4/2010
'Updated 5/21/2101
'Create a tree structure showing 4 levels of employee reporting
Dim wsTree As Worksheet, wsData As Worksheet
Dim empArr As Variant, emp2Arr As Variant
Dim LR As Long, NR As Long, eRow As Long, EmpName As Long, Emp2Name As Long
Application.ScreenUpdating = False

Set wsData = Sheets("Sheet1")
Set wsTree = Sheets("Sheet2")
If wsTree.UsedRange.Cells.Count > 0 Then wsTree.Cells.Clear
NR = 1

With wsData
    .Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("H1"), Unique:=True
    LR = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H2:H" & LR).Sort Key1:=.Range("H2"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    .Range("I2").FormulaR1C1 = "=COUNTIF(C1,RC8)"
    .Range("I2").AutoFill Destination:=.Range("I2:I" & LR)
    eRow = .Range("I:I").Find(0, After:=.[I1], LookIn:=xlValues, LookAt:=xlWhole, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row

    .Range("H" & eRow).Copy wsTree.Range("A" & NR)

    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("C:C").AutoFilter Field:=1, Criteria1:=.Range("H" & eRow)
    .Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).Copy wsTree.Range("AA1")
    LR = wsTree.Range("AA" & Rows.Count).End(xlUp).Row
    empArr = Application.WorksheetFunction.Transpose(wsTree.Range("AA1:AA" & LR + 1).Value2)
    wsTree.Range("AA1:AA" & LR).ClearContents
    .Range("C:C").AutoFilter Field:=1
    .Range("H:I").Clear

    For EmpName = 1 To UBound(empArr)
        If empArr(EmpName) <> "" Then
            wsTree.Range("B" & NR).Value = empArr(EmpName)
            .Range("C:C").AutoFilter Field:=1, Criteria1:=empArr(EmpName)
            .Range("A2:A" & .Rows.Count).SpecialCells(xlCellTypeVisible).Copy wsTree.Range("AA1")
            LR = wsTree.Range("AA" & Rows.Count).End(xlUp).Row
            emp2Arr = Application.WorksheetFunction.Transpose(wsTree.Range("AA1:AA" & LR).Value2)
            wsTree.Range("AA1:AA" & LR).ClearContents
            For Emp2Name = 1 To UBound(emp2Arr)
                wsTree.Range("C" & NR) = emp2Arr(Emp2Name)
                .Range("C:C").AutoFilter Field:=1, Criteria1:=emp2Arr(Emp2Name)
                .Range("A2:A" & .Rows.Count).SpecialCells(xlCellTypeVisible).Copy wsTree.Range("D" & NR)
                NR = wsTree.Range("D" & Rows.Count).End(xlUp).Row + 1
            Next Emp2Name
        End If
    Next EmpName

End With

wsData.AutoFilterMode = False
wsTree.Activate
Cells.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

I guess the 4 steps is the problem. God is at the top, H56l6g5nst56n,4nn5 reports to God, and then there are probably 5 or 6 other levels down to the bottom level. How do we get past the 4th level?

I deleted God (VERY scary move), and ran the macro again. Got the error message "Run Time error 91 Object Variable or With Block variable not set" at this line

eRow = .Range("I:I").Find(0, After:=.[I1], LookIn:=xlValues, LookAt:=xlWhole, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row

Originally Posted by jomili

I deleted God (VERY scary move), and ran the macro again. Got the error message "Run Time error 91 Object Variable or With Block variable not set" at this line

eRow = .Range("I:I").Find(0, After:=.[I1], LookIn:=xlValues, LookAt:=xlWhole, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row

You can't delete the zero-level person in the original macro. Everything is flowing backwards from there.

My macro isn't going to work, I'm not sure how to approach your data. Look at these samples. Notice the path from first entry employee to God is a different number of steps for different people? Some people it's 6 steps, some 7 and some 8...and that's when I stopped looking. There may be many more levels.

St6nn5tt,Rh7nd4 R	Z56gl5r,Tr6c64 M
Z56gl5r,Tr6c64 M	V6n5ll4,H7ll9 M
V6n5ll4,H7ll9 M		Br7wn,Sh5l64 F495
Br7wn,Sh5l64 F495	McC4ll,C7ll55n W
McC4ll,C7ll55n W	D5ck6ng4,48dr59
D5ck6ng4,48dr59		H56l6g5nst56n,4nn5
H56l6g5nst56n,4nn5	God

Sm6th-Bl4ck,L48r4 D	Z494s,G84d4l8p5 M
Z494s,G84d4l8p5 M	W4r6ng L4hm595r,S8s4n M
W4r6ng L4hm595r,S8s4n M	B4t5m4n,Ch4rl4n5 R
B4t5m4n,Ch4rl4n5 R	R4sc7,S4sh4 W
R4sc7,S4sh4 W		H56l6g5nst56n,4nn5
H56l6g5nst56n,4nn5	God

V6ll4rr54l,J46m5 7s65l	Z4v4l4,L86s L
Z4v4l4,L86s L		B5t4nc78rt,S4ndr4
B5t4nc78rt,S4ndr4	W77ds,V5r7n6c4 J
W77ds,V5r7n6c4 J	M7r4l5s,M G
M7r4l5s,M G		McC4ll,C7ll55n W
McC4ll,C7ll55n W	D5ck6ng4,48dr59
D5ck6ng4,48dr59		H56l6g5nst56n,4nn5
H56l6g5nst56n,4nn5	God

V5l4,R7b5rt J7s5ph	9z4g86rr5,M4r6n4 C
9z4g86rr5,M4r6n4 C	M7r4l5s,M G
M7r4l5s,M G		McC4ll,C7ll55n W
McC4ll,C7ll55n W	D5ck6ng4,48dr59
D5ck6ng4,48dr59		H56l6g5nst56n,4nn5
H56l6g5nst56n,4nn5	God

No, I would leave this thread alone. A new thread will garner new contributors and more attention.

Leave this thread closed and start a new one, to keep the mods happy, indicate this is a new need and provide a link back to this original thread.


You should construct a good sample "results" page too, your new data is much more inconsistent, and you should be the one thinking through how it should look with people being 4,5,6,7,8 levels differently.