# Create a table that lists macros in a workbook or worksheet

I'm updating an Excel workbook that I've inherited and had to figure out if/when/where Functions/Subs were being called. Ran into instances where in the code I couldn't find it being called and deleted/comment out, only to have it run into an error later on since a button uses it. The code that follows is an attempt to help avoid breaking things before proceeding with updates. There's a lot more work to do before I'm satisfied but would like some help in reviewing what I have so far.

Public Sub ListMacrosCalledInActiveSHEET()
ListMacrosCalled ActiveSheet
End Sub
Public Sub ListMacrosCalledInActiveWORKBOOK()
ListMacrosCalled
End Sub

Private Sub ListMacrosCalled(Optional ActSheet As Worksheet)
Const Delimit As String = "|"
Const ColSpan As Long = 4
Const InputMessage As String = "Choose a cell where you want the table to be created."
Dim Source As Variant
Dim InputCell As Range

'Determine location for table
On Error Resume Next
''CP: Refactor: Functionalize GetInputCell
Set InputCell = Application.InputBox(InputMessage, Type:=8)
If InputCell Is Nothing Then End
On Error GoTo 0

Application.ScreenUpdating = False
Header = join(Array("Worksheet", "TopLeftCell", "ButtonText", "MacroCalled"), Delimit)

If ActSheet Is Nothing Then
Set Source = ActiveWorkbook.Worksheets
Else
Source = Array(ActSheet)
End If

Dim WS As Variant
Dim Shp As Shape
Dim Row As Long, Col As Long
Dim Response As Long
Const MsgOverwrite As String = "You are about to overwrite information. Overwrites cannot be undone..."
'Refactor: Using downtime refactor overwrite checking
If Not IsEmpty(Cells(InputCell.Row, InputCell.Column)) Then
Response = MsgBox(MsgOverwrite, vbYesNo + vbCritical, "Do you wish to continue?")
If Response = vbNo Then End
End If

Row = InputCell.Row + 1
Col = InputCell.Column

For Each WS In Source
If WS.Shapes.Count > 0 Then
For Each Shp In WS.Shapes
'Populate each valid entry
Dim Value As String
Dim TopLeftCell As String, btnText As String, MacroName As String
If Shp.Type = msoFormControl And Not UCase(Shp.Name) Like "*DROP DOWN*" Then 'Only get information about form controls (Buttons)

Const Unattached As String = "<No attached macros>"
btnText = Shp.TextFrame.Characters.Text
MacroName = Replace(Shp.OnAction, "'" & ActiveWorkbook.Name & "'!", vbNullString)

If Len(MacroName) = 0 Then MacroName = Unattached

'Replace any carriage returns with <space>
Value = Replace(join(Array(WS.Name, TopLeftCell, btnText, MacroName), Delimit), Chr(10), " ")

If IsEmpty(Cells(Row, Col)) Then
Cells(Row, Col).Value2 = Value
Else
Response = MsgBox(MsgOverwrite, vbYesNo + vbCritical, "Do you wish to continue?")
If Response = vbNo Then
'Clear whatever was populated
InputCell.Resize(Row - InputCell.Row).ClearContents
End
End If
End If
Row = Row + 1
End If
Next
End If
Next

If IsEmpty(Cells(InputCell.Row + 1, Col)) Then Cells(InputCell.Row + 1, Col).Value2 = WorksheetFunction.Rept(Unattached & Delimit, ColSpan)

''CP: Refactor: Coerce data into table
Dim MacrosCalled As Long
Dim MacroTable As Range
MacrosCalled = Row - InputCell.Row
Set MacroTable = InputCell.Resize(MacrosCalled, ColSpan)
MacroTable.Columns(1).TextToColumns Destination:=InputCell, DataType:=xlDelimited, Other:=True, OtherChar:=Delimit

Dim TableName As String
If ActSheet Is Nothing Then
TableName = "tblMacrosCalledInActiveBOOK"
Else
TableName = "tblMacrosCalledInActiveSHEET"
End If

Application.ScreenUpdating = True
End Sub

• You migh be interested in checking out Rubberduck, to fix the indentation, locate dead code, know what's calling what, refactor/rename things, etc.; it's open-source, completely free and built by myself and a bunch of VBA regulars on Code Review and Stack Overflow. Cheers! Feb 25 '17 at 0:34
• I've just found out about your project and it interests me greatly. I was hoping someone might be able to help me improve my code with some suggestions. I've over the years taught my self VBA and am constantly trying to improve my skillset with it. Feb 25 '17 at 0:50
• You've come to the best place on the webz for that! I'm sure you'll get great reviews =) Feb 25 '17 at 1:41
• As opposed to other languages, VBA does not care where in a subroutine a Dim statement is placed, the variable is local to the entire routine. I therefore prefer all declarations to be at the top of the routine so they are easier to find. For the same reason (easy to find) I prefer each declaration to be on its own line. I see your code contains an End statement. Not a very good idea if you have any module or workbook-level variables you'd like to retain. Feb 25 '17 at 18:48
• There are always personal preferences, which is not a bad thing at all. PS: Shift+F2 takes you to a variables declaration. Feb 26 '17 at 18:17

### Variable Naming

Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

Const DELIMIT as String = "|"
Dim inputCell as Range


You did a good job dimensioning all your variables! Something you might want to do is always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

Variable names - give your variables meaningful names.

Dim WS As Variant
Dim Shp As Shape
Dim Row As Long, Col As Long
Dim Response As Long


Why is WS a Variant? I'd avoid using Row as it's a default member. Also is Response a Long or is it a VbMsgBoxResult type?

Dim targetSheet As Worksheet
Dim targetShape As Shape
Dim targetRow As Long
Dim targetColumn As Long
Dim confirmOverwrite As VbMsgBoxResult


In general, a For Each loop is slower than a For Next loop. So here -

If WS.Shapes.Count > 0 Then
For Each Shp In WS.Shapes


You could just do this:

For sheetindex = 1 To Source.Worksheets.Count
numberofshapes = Source.Sheets(sheetindex).Shapes.Count
If numberofshapes > 0 Then
For shapeindex = 1 To numberofshapes


Or better yet:

For sheetindex = 1 To Source.Worksheets.Count
Set targetSheet = Source.Sheets(sheetindex)
numberofshapes = targetSheet.Shapes.Count
If numberofshapes > 0 Then
For shapeindex = 1 To numberofshapes
Set targetShape = targetSheet.Shapes(shapeindex)


And target your shapes like targetShape.Name.

Or you could wrap some of that in a With clause, if you'd like.

### Error handling

On Error Resume Next
''CP: Refactor: Functionalize GetInputCell
Set InputCell = Application.InputBox(InputMessage, Type:=8)
If InputCell Is Nothing Then End
On Error GoTo 0


This is rough. If you press "Cancel" on the inputbox, you just end. That's not how to want to handle this error:

    Set InputCell = GetUserInput(InputMessage)
If InputCell Is Nothing Then GoTo CleanError
...
CleanError:
Application.ScreenUpdating = True
End Sub

Private Function GetUserInput(ByVal Prompt As String) As Range
On Error GoTo ErrorHandler
Set GetUserInput = Application.InputBox(Prompt, Type:=8)
Exit Function
ErrorHandler:
MsgBox "User Cancelled"
Set GetUserInput = Nothing
End Function


Now you have no Resume Next - which should be avoided at all costs. And no End which is also something to be avoided - it's dangerous. And you've handled the error that is expected and you know what happened. If there is some unexpected error, you'll still get an error code instead of skipping it.

You've also pulled a function out of your main procedure, which makes the main procedure look more clean and isolates the function to do exactly what it should.

Header = Join(Array("Worksheet", "TopLeftCell", "ButtonText", "MacroCalled"), Delimit)


That is kind of an awkward way to do that. Try-

Const HEADER As String = "Worksheet|TopLeftCell|ButtonText|MacroCalled"
Range(Cells(InputCell.Row, InputCell.Column), Cells(InputCell.Row, InputCell.Column + 3)) = headerArray


Private Sub ListMacrosCalled(Optional ActSheet As Worksheet)


If you can, you should pass arguments ByVal instead of ByRef - which is standard. Also, usually if you have an optional argument, you can specify a default:

Private Sub ListMacrosCalled(Optional ByVal ActSheet As Worksheet = Sheet1)


That way this whole thing can be avoided:

If ActSheet Is Nothing Then
Set Source = ActiveWorkbook.Worksheets
Else
Source = Array(ActSheet)
End If


But, since your default is probably ActiveSheet and you can't use that as default, you should make your argument Required instead of Optional.

### Extra

Once you get your table of macros, maybe you want to see if any are missing. You can get a list with something like this

Public Function GetProcedureNames()
Dim VBE As Object
Set VBE = Application.VBE
Dim VBProject As String
Dim VBComponent As Object
Dim count As Long
With VBE
VBProject = .ActiveVBProject.Name
For Each VBComponent In .ActiveVBProject.VBComponents
If Not (InStr(1, VBComponent.Name, "workbook", vbTextCompare) > 0) And Not InStr(1, VBComponent.Name, "sheet", vbTextCompare) > 0 Then
With VBComponent.CodeModule
count = .CountOfDeclarationLines + 1
Do Until count >= .countoflines
Debug.Print .procofline(count, 0) & " on line " & count & " of " & VBComponent.Name & " in " & VBProject
count = count + .ProcCountLines(.procofline(count, 0), 0)
Loop
End With
End If
Next
End With
End Function

• Naming Convention: No convention, yet. Working on consistency. Option Explicit: I always turn it on WS as Variant: Holdover from initial development Default Member: I try to not use Row, sometimes I forget. Resp as Long: Poor habit of using long, never thought to look into VBMsgBoxResult. For…Each vs For...Next: Why would it be faster? Less overhead with long vs variable? Error Handling: This is a topic I need to learn more on. GetInputCell: Cleaner than i would have done myself, thanks. Extra: Walking through the code modules progromatically may prove useful some time in the future. Feb 27 '17 at 18:33
• vbaexpress.com/forum/… Feb 27 '17 at 18:56