Creating a Collapsible Tree Heirarchy in Excel

[Ravelle Wickham]

Application Question : I'm trying to create a collapsible
hierarchy tree structure in excel for a document that I'm
working on.

What I'm trying to achieve is similar to the excel
documents you will find at

<http://www.xcbl.org/xcbl40/documentation.html>

The structure reference documents at xcbl.org, in effect
have rows nested within other rows in a normal
spreadsheet. When the structure are fully collapsed, your
just left with the base outline for the document. This is
a great way to display data that forms part of a larger
group. What I'm trying to determine is whether this is
the result of a fairly complex macro, or whether it can be
easily achieved.

Thanks in advance...

Ravelle






would like to know if this requires some type of macro, or
if there is a simple solution??? Done a bit of searching
and can't find anything on it.....thanks Ravelle

 

[Jan Karel Pieterse]

Hi,

This is done using the Menu: Data, Group and outline.

Read Excel's Help for more information about group and
outline.

Regards,

Jan Karel Pieterse
Excel TA/MVP

 

[keepitcool]

Ravelle,

it depends on the data that you want to categorize.
but you could do it with a fairly simple macro:

if looks at the number of spaces in the cells of column A
and the decides the outline level on that.
then it copies the string between the <> to column B

you'll have to take it from there


Sub Structurizer()
Dim r As Range, c As Range, iSpaces%, iLen%, s$
Dim nums As New Collection

Application.ScreenUpdating = False
Set r = Range([a1], [a65536].End(xlUp))
r.EntireRow.ClearOutline
r.Offset(, 1).Clear

On Error Resume Next
For Each c In r.Cells
iSpaces = Len(c) - Len(LTrim(c))
If iSpaces > 0 Then nums.Add nums.Count + 1, CStr(iSpaces)
Next
On Error GoTo 0
If nums.Count > 9 Then
MsgBox "Maximum Nr of levels is 9": Exit Sub
Else

For Each c In r.Cells
iSpaces = Len(c) - Len(LTrim(c))
If iSpaces > 0 Then c.EntireRow.OutlineLevel = nums(CStr(iSpaces))
s = Mid(LTrim(c), 2)
iLen = InStr(s, ">")
If iLen > 1 Then s = Left(s, iLen - 1)
c(1, 2) = s
Next
End If
Application.ScreenUpdating = True

End Sub


keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >