PDA

View Full Version : [SOLVED] Problem with "ReDim Preserve"



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

mvidas
05-18-2005, 12:21 PM
Hi cd,

At the top of your RefreshMacroList sub, just include the line


ReDim DetailsAry(1 To 3, 1 To 1)

It is the "Preserve" you're using otherwise (which is necessary in the context it is in) that is keeping the old values, this will 'reset' it back to a starting position when your macro is first run. Should take care of your issue.
Matt

Cyberdude
05-18-2005, 08:55 PM
mvidas, thanx for the reply. I understand that it is the PRESERVE thats causing the problem, I just didn't know how to reset it without interfering with the loop that is making use of it. Anyway, I'll give it a try tomorrow. :hi:

Richie(UK)
05-19-2005, 04:02 AM
Hi dude,

There are, as far as I am aware, two options to clear your array.

1. A Redim without using Preserve, as Matt suggests.
2. The Erase statement.

HTH

Cyberdude
05-19-2005, 09:45 AM
Richie and Matt, I tried both the ReDim and the Erase, and they each had the same results . . . the refresh sheet had all blank lines. It's as though the DetailsAry has to be re-declared again. It looks to me like that's happening, since I call the "GetCodeRoutines" again.
I guess the question to be answered is, when does the array get "discarded", i.e., when does the system think it's no longer being used, and throws away all records of it's existence? I would have thought that once the sheet is created and filled out, then all is over. But apparently not. For some reason, the system is retaining the array. Perhaps if I execute the Erase Statement at the very end of the creation sequence, instead of at the beginning of the Refresh sequence. I'll try it! :thumb

Later:
Putting the Erase at the end of the sheet creation sequence also resulted in a blank sheet. HOWEVER, I found that if I exit the workbook and Excel, then re-enter it, I can run the Refresh ONCE and it works. So I'm right about having the array hanging around after I'm finished using it. What I need to do (if it can be done) is to have the Refresh create a new array some how each time it executes. (Sigh)

mvidas
05-19-2005, 10:34 AM
Have you thought about not making it a public array, just creating it at runtime and passing it from one routine to another? I assume you have a reason you didn't do this in the first place, but it seems like it would solve your problems
Matt

Cyberdude
05-20-2005, 07:57 AM
Matt, believe it or not it has crossed my mind, but I got busy elsewhere and haven't had time to work it out. And, no I don't have a good reason for keeping it public. Thanx for the thought.
My printer just went bad (pffft!). I sure go through a lot of printers it seems to me.
I'm going to mark this thread solved. I don't want to drag it out. I'll keep working on it and report back when I get it working. Thanks to the guys who have made constructive suggestions.

Cyberdude
05-20-2005, 10:48 AM
Final update: I changed the public array to be an argument that I passed around to whomever needed it, and it worked!! So that problem is solved.
However, I have a new one that is puzzeling. When I do the refresh, I noticed that the resulting list of module names and procedure names no longer includes class modules and the workbook module. I have no idea why, but let's save that for another day. :clap: