** Please do not put replies here. Use the original message **
A recent message prompted me to complete a project to show all modules and subroutines in a workbook. As use of VBA to manipulate the VB Editor is a recurring issue I thought it a good idea to share this.
.............................................................
Edit August 2007 - additional code
To delete a Subroutine from a code module selected in the worksheet produced below.
http://www.mrexcel.com/board2/viewtopic.php?p=1393755#1393755
............................................................
A recent message prompted me to complete a project to show all modules and subroutines in a workbook. As use of VBA to manipulate the VB Editor is a recurring issue I thought it a good idea to share this.
.............................................................
Edit August 2007 - additional code
To delete a Subroutine from a code module selected in the worksheet produced below.
http://www.mrexcel.com/board2/viewtopic.php?p=1393755#1393755
............................................................
Code:
'===========================================================================
'- 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 ===================================================