Build a tree as a data representation in Excel?

Question

I have a bunch of raw data this way:

Parent | Data --------------- Root | AAA AAA | BBB AAA | CCC AAA | DDD BBB | EEE BBB | FFF CCC | GGG DDD | HHH 

Which should be transformed into a tree as a fashion. This should basically end in an Excel spreadsheet. How to convert the above data to the following:

 AAA | | | BBB | | | EEE | | FFF | CCC | | | GGG | DDD | | | HHH 

Is there an easy way to do this using only VBA?

Answer 1

I'm sure you can remove this, but it will work with the dataset that you provided.

Before you begin, you will need to define two names (Insert / Name / Define). “Data” is the range of your data set, “Destination” is the place where you want the tree to go.

 Sub MakeTree() Dim r As Integer ' Iterate through the range, looking for the Root For r = 1 To Range("Data").Rows.Count If Range("Data").Cells(r, 1) = "Root" Then DrawNode Range("Data").Cells(r, 2), 0, 0 End If Next End Sub Sub DrawNode(ByRef header As String, ByRef row As Integer, ByRef depth As Integer) 'The DrawNode routine draws the current node, and all child nodes. ' First we draw the header text: Cells(Range("Destination").row + row, Range("Destination").Column + depth) = header Dim r As Integer 'Then loop through, looking for instances of that text For r = 1 To Range("Data").Rows.Count If Range("Data").Cells(r, 1) = header Then 'Bang! We've found one! Then call itself to see if there are any child nodes row = row + 1 DrawNode Range("Data").Cells(r, 2), row, depth + 1 End If Next End Sub 

Answer 2

I had to look for this solution today, and I found it elsewhere if someone is looking for this answer yet

Specify the desired sheet as "INPUT"

and the output sheet is like "STRUCTURE LEVEL"

The form is in parent | child parent | child , so if your data is reversed, just swap the columns. If this is the topmost node, enter root as the name for parent .

Thus, each cell in columns A, B has a certain value in it.

run excel vba

SOURCE: https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/text-functions/cascading-tree

 Option Explicit Sub TreeStructure() 'JBeaucaire 3/6/2010, 10/25/2011 'Create a flow tree from a two-column accountability table Dim LR As Long, NR As Long, i As Long, Rws As Long Dim TopRng As Range, TopR As Range, cell As Range Dim wsTree As Worksheet, wsData As Worksheet Application.ScreenUpdating = False 'Find top level value(s) Set wsData = Sheets("Input") 'create a unique list of column A values in column M wsData.Range("A:A").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=wsData.Range("M1"), Unique:=True 'Find the ONE value in column M that reports to no one, the person at the top wsData.Range("N2", wsData.Range("M" & Rows.Count).End(xlUp) _ .Offset(0, 1)).FormulaR1C1 = "=IF(COUNTIF(C2,RC13)=0,1,"""")" Set TopRng = wsData.Columns("N:N").SpecialCells(xlCellTypeFormulas, 1).Offset(0, -1) 'last row of persons listed in data table LR = wsData.Range("A" & wsData.Rows.Count).End(xlUp).Row 'Setup table Set wsTree = Sheets("LEVEL STRUCTURE") With wsTree .Cells.Clear 'clear prior output NR = 3 'next row to start entering names 'Parse each run from the top level For Each TopR In TopRng 'loop through each unique column A name .Range("B" & NR) = TopR Set cell = .Cells(NR, .Columns.Count).End(xlToLeft) Do Until cell.Column = 1 'filter data to show current leader only wsData.Range("A:A").AutoFilter Field:=1, Criteria1:=cell 'see how many rows this person has in the table LR = wsData.Range("A" & Rows.Count).End(xlUp).Row If LR > 1 Then 'count how many people report to this person Rws = Application.WorksheetFunction.Subtotal(103, wsData.Range("B:B")) - 1 'insert that many blank rows below their name and insert the names cell.Offset(1, 1).Resize(Rws).EntireRow.Insert xlShiftDown wsData.Range("B2:B" & LR).Copy cell.Offset(1, 1) 'add a left border if this is the start of a new "group" If .Cells(.Rows.Count, cell.Column + 1).End(xlUp).Address _ <> cell.Offset(1, 1).Address Then _ .Range(cell.Offset(1, 1), cell.Offset(1, 1).End(xlDown)) _ .Borders(xlEdgeLeft).Weight = xlThick End If NR = NR + 1 'increment to the next row to enter the next top leader name Set cell = .Cells(NR, .Columns.Count).End(xlToLeft) Loop Next TopR 'find the last used column i = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), _ SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'format the used data range With Union(.Range(.[B1], .Cells(1, i)), .Range("B:BB").SpecialCells(xlCellTypeConstants, 23)) .Interior.ColorIndex = 5 .Font.ColorIndex = 2 .Font.Bold = True .HorizontalAlignment = xlCenter End With .Range("B1").Interior.ColorIndex = 53 .Range("B1").Value = "LEVEL 1" .Range("B1").AutoFill Destination:=.Range("B1", .Cells(1, i)), Type:=xlFillDefault End With wsData.AutoFilterMode = False wsData.Range("M:N").ClearContents wsTree.Activate Application.ScreenUpdating = True End Sub