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
-
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\$Mathieu Guindon– Mathieu Guindon2017年02月25日 00:34:31 +00:00Commented 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\$IvenBach– IvenBach2017年02月25日 00:50:45 +00:00Commented 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\$Mathieu Guindon– Mathieu Guindon2017年02月25日 01:41:10 +00:00Commented 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\$jkpieterse– jkpieterse2017年02月25日 18:48:48 +00:00Commented 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\$jkpieterse– jkpieterse2017年02月26日 18:17:19 +00:00Commented Feb 26, 2017 at 18:17
1 Answer 1
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
-
\$\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– IvenBach2017年02月27日 18:33:14 +00:00Commented Feb 27, 2017 at 18:33
-
\$\begingroup\$ vbaexpress.com/forum/… \$\endgroup\$Raystafarian– Raystafarian2017年02月27日 18:56:58 +00:00Commented Feb 27, 2017 at 18:56