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 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>" TopLeftCell = Shp.TopLeftCell.Address 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 ActiveSheet.ListObjects.Add(xlSrcRange, MacroTable, XlListObjectHasHeaders:=xlYes).Name = TableName Application.ScreenUpdating = True End Sub