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
asked Feb 25, 2017 at 0:21
\$\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\$ Commented Feb 25, 2017 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\$ Commented Feb 25, 2017 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\$ Commented Feb 25, 2017 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\$ Commented Feb 25, 2017 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\$ Commented Feb 26, 2017 at 18:17

1 Answer 1

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
answered Feb 25, 2017 at 22:21
\$\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\$ Commented Feb 27, 2017 at 18:33
  • \$\begingroup\$ vbaexpress.com/forum/… \$\endgroup\$ Commented Feb 27, 2017 at 18:56

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.