SHOW ALL CODE MODULES & SUBS IN A WORKBOOK (SOLVED)

'===========================================================================
'- USING VBA TO MANIPULATE THE VB EDITOR
'- CODE TO SHOW ALL MODULES & SUBROUTINES IN A WORKBOOK
'- Makes a new worksheet.
'===========================================================================
'- NB. VB Editor : Tools/References - may need to add reference to ......
'-    .... "Microsoft Visual Basic For Applications Extensibility"
'- Brian Baulsom June 2007
'===========================================================================
Option Base 1
Dim WBname As String
Dim ws As Worksheet
Dim TitleStr As Variant
Dim VBProject As Object
Dim ToRow As Long
Dim ToCol As Integer
'----------------------------------
'- componebts
Dim ComponentType
Dim MyComponent As Object
Dim ComponentName As String
'- Type
Dim TypeArray As Variant
Dim StdCol As Integer
'- module
Dim LastLine As Long
Dim CurrentLineNumber As Long
Dim CurrentLineText As String
'---------------------------------------------------------------------------
'===========================================================================
'- MAIN ROUTINE : GET COMPONENTS OF THE WORKBOOK
'===========================================================================
Sub SHOW_ALL_MODULES()
    WBname = ActiveWorkbook.FullName
    '------------------------------------------------------------------------
    '- RESULTS WORKSHEET SETUP
    On Error Resume Next
    Set ws = ActiveWorkbook.Worksheets("WB Contents")
    If Err.Number <> 0 Then ' sheet not exist
        Set ws = ActiveWorkbook.Sheets.Add(before:=Sheets(1))
        ws.Name = "WB Contents"
        ws.Rows("1:2").EntireRow.Cells.Font.Bold = True
        ws.Cells.Font.Size = 8
    End If
    On Error GoTo 0
    '------------------------------------------------------------------------
    '- clear/format sheet for new data
    ws.Cells.ClearContents
    TypeArray = Array("Standard", "Form", "Sheet", "Class")
    TitleStr = Array("Modules", "Subs")
    C = 1
    For t = 1 To 4
        ws.Cells(1, C).Value = TypeArray(t)
        ws.Range(Cells(2, C), Cells(2, C + 1)).Value = TitleStr
        ws.Cells(2, C).EntireColumn.ColumnWidth = 20
        ws.Cells(2, C + 1).EntireColumn.ColumnWidth = 30
        ws.Cells(2, C + 2).EntireColumn.ColumnWidth = 1
        C = C + 3
    Next
    StdCol = 1
    '--------------------------------------------------------------------------
    '- LOOP THROUGH COMPONENTS
    For Each MyComponent In ActiveWorkbook.VBProject.vbComponents
        ComponentType = MyComponent.Type
        Select Case ComponentType
            Case vbext_ct_StdModule     '1 Standard module
                ToCol = StdCol
                ComponentName = MyComponent.Name
            Case vbext_ct_ClassModule   '2 Class module
                ToCol = StdCol + 9
                ComponentName = MyComponent.Name
            Case vbext_ct_MSForm        '3 Microsoft Form
                ToCol = StdCol + 3
                ComponentName = MyComponent.Name
            Case vbext_ct_Document      '100 Document Module
                ToCol = StdCol + 6
                '--------------------------------------------------------------
                '- check for worksheet tab name instead of CodeName
                If MyComponent.Name <> "ThisWorkbook" Then
                    nm = "*sheet name error"   'shows missed item on the sheet
                    For Each s In ActiveWorkbook.Worksheets
                        If s.CodeName = MyComponent.Name Then
                            nm = s.Name
                        End If
                    Next
                    ComponentName = nm
                Else
                    ComponentName = MyComponent.Name
                End If
        End Select
        ShowSubroutines
    Next
    '--------------------------------------------------------------------------
    '- finish
    MsgBox ("Done")
End Sub
'= END OF MAIN ROUTINE ========================================================


'==============================================================================
'- SUBROUTINE : DETAILS TO SHEET
'==============================================================================
Private Sub ShowSubroutines()
    ToRow = ws.Cells(1, ToCol).End(xlDown).Row + 1
    ws.Cells(ToRow, ToCol).Value = ComponentName
    '--------------------------------------------------------------------------
    '- loop lines of code
    With MyComponent.CodeModule
        LastLine = .CountOfLines
        CurrentLineNumber = 1
        '-----------------------------------------------------------------------
        '- loop lines of code in the module
        While CurrentLineNumber < LastLine
            CurrentLineText = .Lines(CurrentLineNumber, 1)
            '-------------------------------------------------------------------
            '- check lines of code
            If (Left(CurrentLineText, 4) = "Sub " _
                Or Left(CurrentLineText, 12) = "Private Sub " _
                Or Left(CurrentLineText, 8) = "Function" _
                Or Left(CurrentLineText, 16) = "Private Function") Then
                '---------------------------------------------------------------
                '- show details in worksheet
                ws.Cells(ToRow, ToCol).Value = ComponentName
                ws.Cells(ToRow, ToCol + 1).Value = CurrentLineText
                ws.Cells(ToRow, ToCol + 2).Value = " " ' space to stop overflow
                ToRow = ToRow + 1
                '---------------------------------------------------------------
            End If
            '-------------------------------------------------------------------
            CurrentLineNumber = CurrentLineNumber + 1
        Wend
    End With
End Sub
'============ end of project ===================================================