Can you write a Macro to delete a macro.

APPPRO

Active Member
Joined
Aug 6, 2002
Messages
256
I have a workbook with sveral macros that after the initial data entry become useless. I want the user to be able to delete them to reduce memory before they do a Save As.

Can a macro attached to a click buttton be written to do this. You can't record it!
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
The procedure below will delete the module named "NewModule" from ThisWorkbook.

Sub DeleteModule()
Dim VBComp As VBComponent
Set VBComp = ThisWorkbook.VBProject.VBComponents("NewModule")
ThisWorkbook.VBProject.VBComponents.Remove VBComp
End Sub

Try that.
 
Upvote 0
try this also
Sub Delete_Module_test()
On Error Resume Next
DeleteName = "test"
With Application.VBE.ActiveVBProject.VBComponents
.Remove VBComponent:=.Item(DeleteName)
End With
End Sub


_________________<FONT SIZE=4 COLOR="red">Paul B</FONT>
Remember To Always Back Up Your Data Before Trying Something New
Using Excel '97
This message was edited by Paul B on 2002-11-01 15:26
 
Upvote 0
<PRE><FONT color=red>Option Explicit</FONT>



<FONT color=#339966>'-----------------------------------------------------------------------------------
</FONT>
<FONT color=#339966>'This code will delete all procedures of xls files which located in the choosen folder
</FONT>
<FONT color=#339966>'The code lines of the files in sub folders will be deleted also.
</FONT>


<FONT color=#339966>'*PLEASE NOTE:
</FONT>
<FONT color=#339966>' Need to reference 'MIcrosoft Visual Basic for Applications Extensibility'
</FONT>
<FONT color=#339966>' Need to reference 'Microsoft Scripting Runtime'
</FONT>
<FONT color=#339966>' If you get messgae from excel like this "Module Not Found" then just press [OK]
</FONT>
<FONT color=#339966>'-----------------------------------------------------------------------------------
</FONT>


<FONT color=red>Public </FONT><FONT color=red>Sub </FONT>DeleteAllProc()

<FONT color=red>Const </FONT>strMsg <FONT color=red>As</FONT><FONT color=red> String</FONT> = "Please browse to the folder that contains xls files" _

& vbLf & "which you want to delete procedure."

<FONT color=red>Const </FONT>strCnf1 <FONT color=red>As</FONT><FONT color=red> String</FONT> = "All procedures will be deleted in above path"

<FONT color=red>Const </FONT>strCnf2 <FONT color=red>As</FONT><FONT color=red> String</FONT> = "Are you sure?"

<FONT color=red>Dim </FONT>fso <FONT color=red>As</FONT><FONT color=red> New </FONT>Scripting.FileSystemObject



<FONT color=red>Dim </FONT>objFolder <FONT color=red>As</FONT><FONT color=red> Object</FONT>

<FONT color=red>Dim </FONT>strPath <FONT color=red>As</FONT><FONT color=red> String</FONT>

<FONT color=red>Dim </FONT>intCancelCnt <FONT color=red>As</FONT><FONT color=red> Integer</FONT>

<FONT color=red>Dim </FONT>lngRet <FONT color=red>As</FONT><FONT color=red> Long</FONT>



reSelect:

<FONT color=red>Set </FONT>objFolder = CreateObject("Shell.Application"). _

BrowseForFolder(0, strMsg, &H1)

<FONT color=red>If </FONT>Not objFolder Is<FONT color=red> Nothing</FONT> Then

strPath = objFolder.self.Path

<FONT color=red>Else</FONT>

MsgBox strMsg, vbCritical

<FONT color=red>Set </FONT>objFolder =<FONT color=red> Nothing</FONT>

intCancelCnt = intCancelCnt + 1

<FONT color=red>If </FONT>intCancelCnt = 3<FONT color=red> Then </FONT><FONT color=red>Exit Sub</FONT>

<FONT color=red>GoTo</FONT> reSelect

<FONT color=red>End If</FONT>



lngRet = MsgBox(strPath & vbLf & strCnf1 & vbLf & vbLf & strCnf2, 36)

<FONT color=red>If </FONT>lngRet = vbYes<FONT color=red> Then </FONT><FONT color=red>Call</FONT> SeekFolder(objFolder.self.Path)

<FONT color=red>End Sub</FONT>



<FONT color=red>Private <FONT color=red>Sub </FONT></FONT>SeekFolder(<FONT color=red>ByVal</FONT> strPath <FONT color=red>As</FONT><FONT color=red> String</FONT>)

<FONT color=red>Const </FONT>strNotFound <FONT color=red>As</FONT><FONT color=red> String</FONT> = "There is NO Excel files..."

<FONT color=red>Dim </FONT>ffTmp <FONT color=red>As</FONT> FoundFiles

<FONT color=red>Dim </FONT>wb <FONT color=red>As</FONT><FONT color=red> Workbook</FONT>

<FONT color=red>Dim </FONT>objVbc <FONT color=red>As</FONT><FONT color=red> Object</FONT>

<FONT color=red>Dim </FONT>objFile <FONT color=red>As</FONT><FONT color=red> Variant</FONT>

<FONT color=red>Dim </FONT>strLogFile <FONT color=red>As</FONT><FONT color=red> String</FONT>

<FONT color=red>Dim </FONT>strErrFile <FONT color=red>As</FONT><FONT color=red> String</FONT>

<FONT color=red>Dim </FONT>lngRet <FONT color=red>As</FONT><FONT color=red> Long</FONT>

<FONT color=red>Dim </FONT>blnError <FONT color=red>As</FONT> <FONT color=red>Boolean</FONT>

<FONT color=red>Dim </FONT>FreeFile1 <FONT color=red>As</FONT><FONT color=red> Integer</FONT>, FreeFile2 <FONT color=red>As</FONT><FONT color=red> Integer</FONT>



<FONT color=red>On Error</FONT> <FONT color=red>GoTo</FONT> Make_ErrorLog

Application.DisplayAlerts =<FONT color=red> False</FONT>



strLogFile = ThisWorkbook.Path & "DeleteProcLog.txt"

strErrFile = ThisWorkbook.Path & "ErrorLog.txt"



<FONT color=#339966> 'Search Excel files
</FONT>
<FONT color=red>With </FONT>Application.FileSearch

.NewSearch

.LookIn = strPath

.SearchSubFolders =<FONT color=red> True</FONT>

.FileType = msoFileTypeExcelWorkbooks

<FONT color=red>If </FONT>.Execute > 0 Then

<FONT color=red>Set </FONT>ffTmp = .FoundFiles

<FONT color=red>Else</FONT>

MsgBox strNotFound: <FONT color=red>Exit Sub</FONT>

<FONT color=red>End If</FONT>

<FONT color=red>End With</FONT>



<FONT color=red>For </FONT>Each objFile In ffTmp

Application.EnableEvents =<FONT color=red> False</FONT>

SetAttr objFile, vbNormal <FONT color=#339966>'Just in case
</FONT>
<FONT color=red>Set </FONT>wb =<FONT color=red> Workbook</FONT>s.Open(objFile)

<FONT color=red>For </FONT>Each objVbc In wb.VBProject.VBComponents

If<FONT color=red> Workbook</FONT>s(wb.Name).VBProject.Protection = vbext_pp_none Then



Select <FONT color=red>Case </FONT>objVbc.Type

<FONT color=red>Case </FONT>1, 3 <FONT color=#339966>'Std module and Userform
</FONT>
wb.VBProject.VBComponents.Remove objVbc

<FONT color=red>Case </FONT>100 <FONT color=#339966>'Sheet and Class and Thisworkbook module
</FONT>
<FONT color=red>With </FONT>objVbc.CodeModule

.DeleteLines 1, .CountOfLines

<FONT color=red>End With</FONT>

<FONT color=red>End Select</FONT>

<FONT color=red>If </FONT>Not blnError Then

FreeFile1 = FreeFile

<FONT color=red>Open </FONT>strLogFile <FONT color=red>For </FONT>Append <FONT color=red>As</FONT> #FreeFile1

<FONT color=red>Print </FONT>#FreeFile1, Now & " " & _

wb.Name & ":" & _

objVbc.Name & ":" & "Is Deleted"

<FONT color=red>Close </FONT>#FreeFile1

<FONT color=red>End If</FONT>

<FONT color=red>Else</FONT>

<FONT color=red>Open </FONT>strLogFile <FONT color=red>For </FONT>Append <FONT color=red>As</FONT> #1

<FONT color=red>Print </FONT>#1, Now & " " & _

wb.Name & ":" & _

objVbc.Name & ":" & _

" Can't perform operation since the project is protected"

<FONT color=red>Close </FONT>#1

<FONT color=red>End If</FONT>

blnError =<FONT color=red> False</FONT>

Next

wb.Close<FONT color=red> True</FONT>

Application.EnableEvents =<FONT color=red> True</FONT>

Next



lngRet = Shell("notepad.exe " & strLogFile, vbNormalFocus)

lngRet = Shell("notepad.exe " & strErrFile, vbNormalFocus)

Application.DisplayAlerts =<FONT color=red> True</FONT>

<FONT color=red>Exit Sub</FONT>



Make_ErrorLog:

FreeFile2 = FreeFile

<FONT color=red>Open </FONT>strErrFile <FONT color=red>For </FONT>Append <FONT color=red>As</FONT> #FreeFile2

<FONT color=red>Print </FONT>#FreeFile2, Now & " " & Err.Number & ":" & Err.Description

<FONT color=red>Close </FONT>#FreeFile2

blnError =<FONT color=red> True</FONT>

<FONT color=red>Resume </FONT>Next

<FONT color=red>End Sub</FONT>


</PRE>
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,245
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top