7
\$\begingroup\$

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
\$\endgroup\$
9
  • 3
    \$\begingroup\$ 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! \$\endgroup\$ Feb 25 '17 at 0:34
  • \$\begingroup\$ 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. \$\endgroup\$
    – IvenBach
    Feb 25 '17 at 0:50
  • 1
    \$\begingroup\$ You've come to the best place on the webz for that! I'm sure you'll get great reviews =) \$\endgroup\$ Feb 25 '17 at 1:41
  • \$\begingroup\$ 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. \$\endgroup\$
    – jkpieterse
    Feb 25 '17 at 18:48
  • 1
    \$\begingroup\$ There are always personal preferences, which is not a bad thing at all. PS: Shift+F2 takes you to a variables declaration. \$\endgroup\$
    – jkpieterse
    Feb 26 '17 at 18:17
5
\$\begingroup\$

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
            End If
        Next
    End With
End Function
\$\endgroup\$
2
  • \$\begingroup\$ 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. \$\endgroup\$
    – IvenBach
    Feb 27 '17 at 18:33
  • \$\begingroup\$ vbaexpress.com/forum/… \$\endgroup\$ Feb 27 '17 at 18:56

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.