Cyberdude
05-18-2005, 11:34 AM
Shown below is the code ("ListMacroNames") for creating a sheet that contains the names of all the modules and macros in the workbook that invokes it. It works very well.
On the sheet is a "Refresh" button that is supposed to cause the current sheet to be deleted, then a new sheet created with the most recent information on it. The problem is that the code in the macro "GetCodeRoutines" uses a ReDim statement that includes the Preserve option. As a consequence, when the macros run the next time after a sheet has been created, I get the old information lines as well as the new ones. So running macro "RefreshMacroList" will show two copies of each detail line. If I run it a third time, then I have three copies of each detail line.
I tried clearing the array DetailsAry by setting each element to blank before calling "ListMacroNames" again, but then all the details were blank.
My question is, how do I clear the residual values in array DetailsAry without it having an impact on the next execution of macro "RefreshMacroList"? I thought that clearing the array would do it, but for some reason the macro "GetCodeRoutines" doesn 't seem to be able to refill the array with new values. It seems satisfied with the blank values.
Dim DetailLineNo As Long '<--(Used by "ListMacroNames" & "GetCodeRoutines")
Dim DetailsAry() '<--(Used by "ListMacroNames" & "GetCodeRoutines")
Sub ListMacroNames(Optional WkbkNm$) '5/9/05 [Called by button]
'Lists all the macro procedure names in all the modules in the active workbook
'When the arg "WkbkNm" has a value, then suppress questions.
Dim oVBC As Object, Buttons As Object, WkBk As Workbook, Temp$, Title$, RC%
Dim SheetCnt%, RevNo%, MacroCnt%, CurrModuleNm$, ModuleCurrColor%, MacroCurrColor%
Dim N%, J%, K%, Row%, Col1%, Col2%, Col3%, FoundCnt%, StartAddr$, Msg$, Ans$, LitVal$
Dim NewSheetName$, RevSheetName$, NewSheet As Object, BotmRow%, ModuleCnt%, UseShtNm$
Dim CallingWkbkNm$
Title = "'Personal.xls' (ListMacroNames)"
'Save the name of the workbook active when this macro was called
CallingWkbkNm = ActiveWorkbook.Name
'Add a link to "Microsoft Visual Basic for Applications Extensibility 5.3" reference library
Call AddExtensibility53AsReference(RC)
If RC <> 0 Then GoTo Finish 'Reference wasn't created
If WkbkNm <> "" Then GoTo Contin 'Skip question for "refresh" process
DetailLineNo = 2 'First details line of the list. (Dimensioned at top of module)
Msg = "Enter the name of the workbook" & vbCr & _
"containing the macros you want to list."
WkbkNm = InputBox(Prompt:=Msg, Title:=Title, Default:=ActiveWorkbook.Name)
If WkbkNm = "" Then GoTo Finish 'If "CANCEL", exit sub
Contin:
'Is the specified workbook open?
On Error Resume Next
Set WkBk = Workbooks(WkbkNm) 'Intentionally causes an error if 'WkbkNm' closed
If Err.Number <> 0 Then GoTo WrkbkNotOpen
On Error GoTo 0
Application.ScreenUpdating = False
For Each oVBC In Workbooks(WkbkNm).VBProject.VBComponents
If Workbooks(WkbkNm).VBProject.Protection = vbext_pp_none _
Then Call GetCodeRoutines(WkbkNm, oVBC.Name)
Next
'Add a new worksheet to the calling workbook for the output list
Workbooks(CallingWkbkNm).Activate
NewSheetName = Cre8EmptyWorksheet("MacroNms")
Application.ScreenUpdating = False
'Write the column headers
With Worksheets(NewSheetName)
.Range("A1").Resize(, 3).Value = Array("Workbook", "Module Names", "Procedure Names")
.Range("A2").Resize(UBound(DetailsAry, 2), _
UBound(DetailsAry, 1)).Value = Application.Transpose(DetailsAry)
.Columns("A:C").Columns.AutoFit
End With
'(Detail logic unrelated to the problem removed from here)
End Sub
Private Sub GetCodeRoutines(WorkbkNm$, VBComp$) '[Called by "ListMacroNames"]
Dim VBCodeMod As Object, StartLine As Long
On Error Resume Next
Set VBCodeMod = Workbooks(WorkbkNm).VBProject.VBComponents(VBComp).CodeModule
With VBCodeMod
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
ReDim Preserve DetailsAry(1 To 3, 1 To DetailLineNo - 1)
DetailsAry(1, DetailLineNo - 1) = WorkbkNm
DetailsAry(2, DetailLineNo - 1) = VBComp
DetailsAry(3, DetailLineNo - 1) = .ProcOfLine(StartLine, vbext_pk_Proc)
DetailLineNo = DetailLineNo + 1
StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), _
vbext_pk_Proc)
If Err Then Exit Sub
Loop
End With
Set VBCodeMod = Nothing
End Sub
Sub RefreshMacroList()
'This macro gets the subject workbook name from the current sheet so
' that the user doesn't have to be prompted again, deletes the current
' sheet, then calls the "ListMacroNames" macro again to construct a
' new sheet.
Dim WkbkNm$
'Get the name of the workbook stored on the current sheet
WkbkNm = Range("A2").Value
'Delete the current sheet
Sheets(ActiveSheet.Name).Select
Application.DisplayAlerts = False 'Suppress system question
ActiveSheet.Delete
Application.DisplayAlerts = True
Call ListMacroNames(WkbkNm)
End Sub
On the sheet is a "Refresh" button that is supposed to cause the current sheet to be deleted, then a new sheet created with the most recent information on it. The problem is that the code in the macro "GetCodeRoutines" uses a ReDim statement that includes the Preserve option. As a consequence, when the macros run the next time after a sheet has been created, I get the old information lines as well as the new ones. So running macro "RefreshMacroList" will show two copies of each detail line. If I run it a third time, then I have three copies of each detail line.
I tried clearing the array DetailsAry by setting each element to blank before calling "ListMacroNames" again, but then all the details were blank.
My question is, how do I clear the residual values in array DetailsAry without it having an impact on the next execution of macro "RefreshMacroList"? I thought that clearing the array would do it, but for some reason the macro "GetCodeRoutines" doesn 't seem to be able to refill the array with new values. It seems satisfied with the blank values.
Dim DetailLineNo As Long '<--(Used by "ListMacroNames" & "GetCodeRoutines")
Dim DetailsAry() '<--(Used by "ListMacroNames" & "GetCodeRoutines")
Sub ListMacroNames(Optional WkbkNm$) '5/9/05 [Called by button]
'Lists all the macro procedure names in all the modules in the active workbook
'When the arg "WkbkNm" has a value, then suppress questions.
Dim oVBC As Object, Buttons As Object, WkBk As Workbook, Temp$, Title$, RC%
Dim SheetCnt%, RevNo%, MacroCnt%, CurrModuleNm$, ModuleCurrColor%, MacroCurrColor%
Dim N%, J%, K%, Row%, Col1%, Col2%, Col3%, FoundCnt%, StartAddr$, Msg$, Ans$, LitVal$
Dim NewSheetName$, RevSheetName$, NewSheet As Object, BotmRow%, ModuleCnt%, UseShtNm$
Dim CallingWkbkNm$
Title = "'Personal.xls' (ListMacroNames)"
'Save the name of the workbook active when this macro was called
CallingWkbkNm = ActiveWorkbook.Name
'Add a link to "Microsoft Visual Basic for Applications Extensibility 5.3" reference library
Call AddExtensibility53AsReference(RC)
If RC <> 0 Then GoTo Finish 'Reference wasn't created
If WkbkNm <> "" Then GoTo Contin 'Skip question for "refresh" process
DetailLineNo = 2 'First details line of the list. (Dimensioned at top of module)
Msg = "Enter the name of the workbook" & vbCr & _
"containing the macros you want to list."
WkbkNm = InputBox(Prompt:=Msg, Title:=Title, Default:=ActiveWorkbook.Name)
If WkbkNm = "" Then GoTo Finish 'If "CANCEL", exit sub
Contin:
'Is the specified workbook open?
On Error Resume Next
Set WkBk = Workbooks(WkbkNm) 'Intentionally causes an error if 'WkbkNm' closed
If Err.Number <> 0 Then GoTo WrkbkNotOpen
On Error GoTo 0
Application.ScreenUpdating = False
For Each oVBC In Workbooks(WkbkNm).VBProject.VBComponents
If Workbooks(WkbkNm).VBProject.Protection = vbext_pp_none _
Then Call GetCodeRoutines(WkbkNm, oVBC.Name)
Next
'Add a new worksheet to the calling workbook for the output list
Workbooks(CallingWkbkNm).Activate
NewSheetName = Cre8EmptyWorksheet("MacroNms")
Application.ScreenUpdating = False
'Write the column headers
With Worksheets(NewSheetName)
.Range("A1").Resize(, 3).Value = Array("Workbook", "Module Names", "Procedure Names")
.Range("A2").Resize(UBound(DetailsAry, 2), _
UBound(DetailsAry, 1)).Value = Application.Transpose(DetailsAry)
.Columns("A:C").Columns.AutoFit
End With
'(Detail logic unrelated to the problem removed from here)
End Sub
Private Sub GetCodeRoutines(WorkbkNm$, VBComp$) '[Called by "ListMacroNames"]
Dim VBCodeMod As Object, StartLine As Long
On Error Resume Next
Set VBCodeMod = Workbooks(WorkbkNm).VBProject.VBComponents(VBComp).CodeModule
With VBCodeMod
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
ReDim Preserve DetailsAry(1 To 3, 1 To DetailLineNo - 1)
DetailsAry(1, DetailLineNo - 1) = WorkbkNm
DetailsAry(2, DetailLineNo - 1) = VBComp
DetailsAry(3, DetailLineNo - 1) = .ProcOfLine(StartLine, vbext_pk_Proc)
DetailLineNo = DetailLineNo + 1
StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), _
vbext_pk_Proc)
If Err Then Exit Sub
Loop
End With
Set VBCodeMod = Nothing
End Sub
Sub RefreshMacroList()
'This macro gets the subject workbook name from the current sheet so
' that the user doesn't have to be prompted again, deletes the current
' sheet, then calls the "ListMacroNames" macro again to construct a
' new sheet.
Dim WkbkNm$
'Get the name of the workbook stored on the current sheet
WkbkNm = Range("A2").Value
'Delete the current sheet
Sheets(ActiveSheet.Name).Select
Application.DisplayAlerts = False 'Suppress system question
ActiveSheet.Delete
Application.DisplayAlerts = True
Call ListMacroNames(WkbkNm)
End Sub