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 Header As String
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

Cells(InputCell.Row, InputCell.Column).Value2 = Header
Row = InputCell.Row + 1
Col = InputCell.Column

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)
Cells(InputCell.Row, InputCell.Column).Value2 = Header

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

Const HEADER As String = "Worksheet|TopLeftCell|ButtonText|MacroCalled"
Dim headerArray() As String
headerArray = Split(HEADER, Delimit)
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

StackExchange Code Review Q#156255, answer score: 5