How to display direct and indirect counts for Subordinates in Visio Organization

I have seen a large number of posts related to this, but unfortunately I could not find an easy answer to being able to display counts in org charts for Visio. As a result, I coded (hacked may be a better term) the following macro for the desired functionality. Hopefully others will find it useful.

• RecursiveCount - This is a recursive method that count subs uses and it does all the work.
• CountSubs - This is the starting point. Select the top most node in your org chart, then run this macro.
• SetCountsToBlank - This is a little helper macro that resets all the org shapes on your diagram to "".
• MakeBoxesBigger - This is another little helper macro that runs through and re-sizes your shapes. I have used this when I get long names, etc. with moderate success. There may be better ways to do this within the orgchart stuff.

Function RecursiveCount(s As Shape) As String
    Dim count As Integer
    
    count = 0
    dc = s.FromConnects.count - 1
    
    For i = 1 To s.FromConnects.count
       If s.Text <> s.FromConnects(i).FromSheet.Connects(2).ToSheet.Text Then
            count = count + 1
            rc = RecursiveCount(s.FromConnects(i).FromSheet.Connects(2).ToSheet)
            count = count + rc
       End If
    Next
    If dc > 0 Then
        s.Shapes(4).Text = dc
        If (count > 0) And (count <> dc) Then
            s.Shapes(4).Text = s.Shapes(4).Text & "(" & count & ")"
        End If
    End If
    RecursiveCount = count
End Function
 
Sub CountSubs()
    ' select the top most node then run this macro
    Dim s As Shape
    Set s = ActiveWindow.Selection(1)
    
    ' now recursively update counts
    i = RecursiveCount(s)
    
End Sub
 
Sub SetCountsToBlank()
Dim s As Shape
For Each s In ActivePage.Shapes
        If s.Shapes.count >= 4 Then
            s.Shapes(3).Text = ""
            s.Shapes(4).Text = ""
    
        End If
    Next
End Sub
 
Sub MakeBoxesBigger()
Dim s As Shape
For Each s In ActivePage.Shapes
    If (s.Type = 2) Then
        s.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "1.37 in"
        s.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "0.6 in"
    End If
    Next
End Sub