VBA Macro with Smart Art

[SRpakse]

Hi All,

I have a VBA macro code that works on a organisational chart and works pretty well based on pre-defined criteria based on Levels.So for example there is a director of sales and Level 1 is a senior Sales Manager who would report to the director of sales and Level 2 is a sales Manager that reports to the senior sales manager and level 3 is a sales rep who would report to the sales manager and so on.

Is there a way to break up the levels so that a level 2 (the sales manager) for example can report directly to the sales director?

Below is the macro code I obtained from the web, my knowledge of VBA is very limited but if someone can tell me where to tweak the below to drop a level that would be much appreciated.

Option Explicit


'You can modify the maximum level dept
Public Const nMaxLevelConst As Long = 3


Public Sub MacroRedraw()
Dim oShape As Office.SmartArt
ClearAll
Set oShape = GetSmartArtObject_
HandleStructure_ oShape, ActiveSheet.Cells(4, 1)
End Sub


'Clear All Shapes
Public Sub ClearAll()
Dim oShape As Office.SmartArt

Set oShape = GetSmartArtObject_

Do While (oShape.AllNodes.Count > 1)
oShape.AllNodes.Item(oShape.AllNodes.Count).Delete
Loop
End Sub


Private Function GetSmartArtObject_() As Office.SmartArt
Dim oShape As Excel.Shape

For Each oShape In ActiveSheet.Shapes
If (oShape.Type = msoSmartArt) Then
Set GetSmartArtObject_ = oShape.SmartArt
Exit Function
End If
Next
Set GetSmartArtObject_ = Nothing
End Function


Private Sub HandleStructure_(oShape As Office.SmartArt, oStartCell As Excel.Range)
Dim nLevel As Long, nStartCol As Long
Dim nRow As Long, nCol As Long
Dim oCell As Excel.Range, oParentCell As Excel.Range
Dim bFound As Boolean

nRow = oStartCell.Offset(1, 1).Row
nStartCol = oStartCell.Offset(1, 1).Column
Do
bFound = False
For nCol = nStartCol To nStartCol + nMaxLevelConst - 1
If (ActiveSheet.Cells(nRow, nCol) <> "") Then
bFound = True
Exit For
End If
Next
If Not bFound Then Exit Do

Set oCell = ActiveSheet.Cells(nRow, nCol)
Set oParentCell = FindParent_(oCell, oStartCell)

AddSmartArtNode_ oShape, oCell, oParentCell.Row - oStartCell.Row + 1

nRow = nRow + 1
Loop
End Sub


Private Function FindParent_(oCell As Excel.Range, oStartCell As Excel.Range) As Excel.Range
Dim nRow As Long
Dim nCol As Long, nStartCol As Long
nStartCol = oStartCell.Offset(1, 1).Column

nRow = oCell.Row - 1
Do While (nRow > oStartCell.Row)
For nCol = oCell.Column - 1 To nStartCol Step -1
If (ActiveSheet.Cells(nRow, nCol) <> "") Then
Set FindParent_ = ActiveSheet.Cells(nRow, nCol)
Exit Function
End If
Next
nRow = nRow - 1
Loop

Set FindParent_ = oStartCell
End Function


Private Sub AddSmartArtNode_(oShape As Office.SmartArt, oCell As Excel.Range, nParentIndex As Long)
Dim oParentNode As Office.SmartArtNode
Dim oNode As Office.SmartArtNode

Set oParentNode = oShape.AllNodes(nParentIndex)
Set oNode = oParentNode.AddNode(Position:=msoSmartArtNodeBelow)
oNode.TextFrame2.TextRange.Text = oCell.Value
End Sub


Snap shots of the Levels presented in excel are shown below

[TABLE="width: 500"]
<tbody>[TR]
[TD]Level 1[/TD]
[TD]Level 2[/TD]
[TD]level 3[/TD]
[/TR]
[TR]
[TD]Senior Sales Manager[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Senior Sales Manager[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Sales Manager[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Sales Manager[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Sales Manager[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Sales Manager[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Sales Rep[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Could someone please help me figure this out? Any help would be much appreciated

Thanks
Saj