Skip to content

Outlining a Table

Sometimes I want to see information graphically. It’s not that I can’t read spreadsheets but there are times when it’s just not the best way to see patterns of organization. The visualization tool I use for outlining and Mind Mapping is MindJet’s Mindmanager. It works great when I’m creating mind maps or outlines from scratch but I recently ran into an issue where a customer gave me a table of data including the folders from their existing Enterprise Content Management System. I wanted to visualize the structure so that I could figure out where they were being inconsistent in their organization. Unfortunately I ran into a snag. Mindmanager doesn’t have a direct import of a spreadsheet into an outline. There’s one guy online who’s got a process that routes the information through Word into Mindmanager. Unfortunately this blew up Mindmanager when I tried it – and Word was getting somewhat tempermental because it has you setting heading styles into cells in the table.

After trying a dozen or two different approaches (including XML, Access, etc.) to get a workable outline out of my table I finally threw my hands up and wrote some VBA script that will take a Word document with a table in it and convert it into a document with the appropriate text in headings styles. This is exactly the type of document that Mindmanager expects (since that’s what it creates when it exports.) So I ran the VBA script and got exactly the map I was looking for. I just wish I had settled on this approach before wasting two hours trying everything else.

I’ve included the script below. All you need to do is paste it into your visual basic editor and then run the method. It only processes the first table in the document because I figured you could copy out the table you needed and have it process just that one table. It also turns off screen updating while it’s running to improve performance. Iterating a ton of cells (5000 in the sample I used) takes a while. I’d let the script run for 10 minutes or so for larger lists before starting to get worried about it having locked up. (It processed in about 5,000 cells in 5 minutes on my laptop.) When it’s done save the file and open the file in Mindmanager. It will open the file and show the outline.

As with all my public code, it comes without a warranty. If you believe that it’s useful, please don’t distribute it directly, link folks to this post to get it. I do maintain all rights on the code.

Sub CreateOutlineFromTable()
‘ Get Table
Dim myTable As Table
Set myTable = ActiveDocument.Tables(1)
‘ Create New Document
Dim outDoc As Document
Set outDoc = Application.Documents.Add()
Application.ScreenUpdating = False
‘ Copy Cells
Dim colCount As Integer
colCount = myTable.columns.Count
Dim lastValues() As String
ReDim lastValues(1 To colCount)
Dim myRow As Row
Dim rowIndex As Integer
For rowIndex = 1 To myTable.Rows.Count
Set myRow = myTable.Rows(rowIndex)
ProcessRow myRow, colCount, lastValues, outDoc
Next
Application.ScreenUpdating = True
End Sub

Sub ProcessRow(ByRef myRow As Row, columns As Integer, ByRef lastValues() As String, ByRef outDoc As Document)
Dim colIndex As Integer
For colIndex = 1 To columns Step 1
ProcessColumn colIndex, columns, myRow, lastValues, outDoc
Next
End Sub

Sub ProcessColumn(colIndex As Integer, maxColumns As Integer, ByRef myRow As Row, ByRef lastValues() As String, ByRef outDoc As Document)
Dim cellValue As String
myRow.Cells(colIndex).Select
If (Len(Trim(Selection.Text)) > 2) Then ‘ 2= UTF-16
Selection.MoveEnd wdCharacter, -1 ‘ Column End marker
cellValue = Selection.Text
Else
cellValue = “”
lastValues(colIndex) = “”
End If
If (cellValue <> lastValues(colIndex)) Then
‘ Different, write it out
outDoc.Select
Selection.Collapse wdCollapseEnd
Selection.TypeText cellValue
Selection.Expand wdParagraph
Selection.Style = ActiveDocument.Styles(“Heading ” & colIndex)
Selection.Collapse wdCollapseEnd
Selection.TypeParagraph
lastValues(colIndex) = cellValue
If (colIndex < maxColumns) Then
Dim clearIdx As Integer
For clearIdx = colIndex + 1 To maxColumns
lastValues(clearIdx) = “”
Next
End If
End If
End Sub

No comment yet, add your voice below!


Add a Comment

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.

Share this: