DeleteAllCode Macro

YoungOne

New Member
Joined
Mar 28, 2011
Messages
6
Hi all,

I'm extremely new to VBA as this is only the second task delegated using this application. Needless to say, I'm in need of some knowledgable assistance.

On this project, the background is as follows:
I have a Macro that returns data of all students in a department and a count of all learning plans with the coinciding time taken to complete each related learning item. After a number of long hours, the base report finally works with out problems. For that reason, I'll leave out that extensive code unless necessary.

However, herein lies the issue. Now that the base report is run with information compiled, I'm now given the task to add a separate Sub procedure, after the original Sub CreateReport procedure has ended.

The purpose of this code is to delete the existing Modules within the project as well as 'Save As' the completed report to another location on the HardDrive into folders that must be referenced based upon dynamic company departments.

This code that has been provided for editing is as follows:

Sub DeleteAllCode()

'Trust Access To Visual Basics Project must be enabled.
'From Excel: Tools | Macro | Security | Trusted Sources

Dim x As Integer
Dim Proceed As VbMsgBoxResult
Dim Prompt As String
Dim Title As String

On Error Resume Next
With ActiveWorkbook.VBProject
For x = .VBComponents.Count To 1 Step -1
.VBComponents.Remove .VBComponents(x)
Next x
For x = .VBComponents.Count To 1 Step -1
.VBComponents(x).CodeModule.DeleteLines _
1, .VBComponents(x).CodeModule.CountOfLines
Next x
End With
On Error GoTo 0
End Sub

Call DeleteAllCode
PathName = ThisWorkbook.Path & :)crash:I assume this is where z:\\harddrive is mentioned in double quotes?:oops:)
NewFileName = PathName & "\" & TargetYear & TargetSemester & " Weekly_Sheets " & TargetStudentType & ".xlsx"

' ThisWorkbook.BuiltinDocumentProperties("Comments") = ThisWorkbook.Name


' Create new file
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=NewFileName, _
FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True

End Sub

The problem I'm finding is in the logic of procedure.
First, the procedure deletes all code from the project...
And then it requests to perform the Save As... Does this make sense?

Also, after searching the internet, I've found little help as to specifically defining the PathName as well as NewFileName.

I'm hoping the collective genius of the board will be able to provide some much needed clarification.

Many thanks to you all in advance,
Young
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,961
Office Version
  1. 365
Platform
  1. Windows
Welcome to the board!

Surely it would make more sense to retain the code in the original in case it's needed again for future use.

Your code will 'Save As' without any code modules in the project anyway, you've specified the xlsx file extension which saves as a 'macro free workbook'
 

YoungOne

New Member
Joined
Mar 28, 2011
Messages
6
Thanks jasonb for the warm welcome...
Here's the entire code as you've requested:

Code:
Sub CreateKPIReport()
Dim xlBookStudent As Excel.Workbook
Dim xlSheetStudent As Excel.Worksheet
Dim xlBookSource As Excel.Workbook
Dim xlSheetSource As Excel.Worksheet
Dim xlBookDest As Excel.Workbook
Dim xlSheetDest As Excel.Worksheet
Dim xlSheetOverdue As Excel.Worksheet
Dim xlBookItem As Excel.Workbook
Dim xlSheetItem As Excel.Worksheet
Dim xlImpactSheetDest As Excel.Worksheet
Dim xlDebug As Excel.Worksheet
Dim xlBookDebug As Excel.Workbook
Dim RowCountSource As Long
Dim RowCountDest As Integer
Dim RowCountOverdue As Integer
Dim ItemRowCountDest As Long
Dim ItemRowCountSource As Long
Dim TrainingRowCount As Long
Dim NewRowCountDest As Integer
Dim NewRowCountSource As Integer
Dim NewItemRowCountDest As Integer
Dim CreditHourValue As Double
Dim DebugCounter As Integer
Dim SourceItemCounter As Long
Dim ImpactCount As Integer
Dim ColCountSource As Integer
Dim ColCountDest As Integer
Dim CurValue02 As String
Dim CurValue06 As String
Dim i As Integer
Dim Counter As Integer
Dim ImpactCounter As Integer
Dim TabName As String
Dim fn As Variant
Dim fn1 As Variant
Dim fn3 As Variant
Dim CurValue10 As Double
fn = Application.GetOpenFilename("Excel-files,*.xls;*.csv", _
1, "Select Student Learning Plan File To Open", , False)
If TypeName(fn) = "Boolean" Then Exit Sub
Set xlBookSource = Workbooks.Open(fn)
Set xlSheetSource = xlBookSource.Worksheets(1)
 
fn1 = Application.GetOpenFilename("Excel-files,*.xls;*.csv", _
1, "Select Student Account File To Open", , False)
If TypeName(fn1) = "Boolean" Then Exit Sub
Set xlBookStudent = Workbooks.Open(fn1)
Set xlSheetStudent = xlBookStudent.Worksheets(1)
 
fn3 = Application.GetOpenFilename("Excel-files,*.xls;*.csv", _
1, "Select Item Plan File To Open", , False)
If TypeName(fn3) = "Boolean" Then Exit Sub
 
Set xlBookItem = Workbooks.Open(fn3)
Set xlSheetItem = xlBookItem.Worksheets(1)
Set xlDebug = ThisWorkbook.Worksheets("Debug")
 
Set xlSheetDest = ThisWorkbook.Worksheets("Training Report")
xlSheetDest.Activate
xlSheetDest.Cells.Select
Selection.Clear
 
 
Set xlSheetOverdue = ThisWorkbook.Worksheets("Overdue Items")
xlSheetOverdue.Activate
xlSheetOverdue.Cells.Select
Selection.Clear
 
Set xlImpactSheetDest = ThisWorkbook.Worksheets("Training Impact")
xlImpactSheetDest.Activate
xlImpactSheetDest.Cells.Select
Selection.Clear
 
Set xlDebug = ThisWorkbook.Worksheets("Debug")
xlDebug.Activate
xlDebug.Cells.Select
Selection.Clear
 
thisDate = Date
thisYear = DatePart("yyyy", thisDate)
thisMonth = DatePart("m", thisDate)
 
 
 
 
ImpactCounter = 1
xlImpactSheetDest.Cells(ImpactCounter, 1).Value = "Item ID"
xlImpactSheetDest.Cells(ImpactCounter, 2).Value = "Item Title"
xlImpactSheetDest.Cells(ImpactCounter, 3).Value = "Credit Hours"
 
ItemRowCountDest = 2
ItemRowCountSource = 2
 
ItemLastRow = LastCell(xlSheetItem).Row
 
' Copy Training IDs & Training Titles into Training Impact where Credit Hours is existing
For ItemRowCountSource = 2 To ItemLastRow
CurValue03 = xlSheetItem.Cells(ItemRowCountSource, 1)
CurValue10 = xlSheetItem.Cells(ItemRowCountSource, 35).Value
 
If (Len(CurValue03) > 0) Then
If (CurValue10 > 0) Then
 
ItemRowCountDest = ItemRowCountDest + 1
xlImpactSheetDest.Cells(ItemRowCountDest, 1).Value = xlSheetItem.Cells(ItemRowCountSource, 1).Value
xlImpactSheetDest.Cells(ItemRowCountDest, 2).Value = xlSheetItem.Cells(ItemRowCountSource, 2).Value
xlImpactSheetDest.Cells(ItemRowCountDest, 3).Value = CurValue10
End If
End If
Next ItemRowCountSource
 
 
Counter = 1
xlSheetDest.Cells(Counter, 1).Value = "Employee ID"
xlSheetDest.Cells(Counter, 2).Value = "User Name"
xlSheetDest.Cells(Counter, 3).Value = "Supervisor Name"
xlSheetDest.Cells(Counter, 4).Value = "Overdue"
xlSheetDest.Cells(Counter, 5).Value = "Due This Month"
xlSheetDest.Cells(Counter, 6).Value = "Due In 60 Days"
xlSheetDest.Cells(Counter, 7).Value = "Due In 90 Days"
xlSheetDest.Cells(Counter, 8).Value = "Due by Year End (" & thisYear & ")"
xlSheetDest.Cells(Counter, 9).Value = "Future (>" & thisYear & ")"
xlSheetDest.Cells(Counter, 10).Value = "Total"
RowCountDest = 2
RowCountOverdue = 0
 
SourceItemCounter = 2
DebugCounter = 1
PlanLastRow = LastCell(xlSheetSource).Row
ImpactCount = 3
 
For RowCountSource = 2 To PlanLastRow
CurValue02 = xlSheetSource.Cells(RowCountSource, 2).Value
If (Len(CurValue02) > 0) Then
If (xlSheetDest.Cells(RowCountDest, 2).Value <> CurValue02) Then
RowCountDest = RowCountDest + 1
xlSheetDest.Cells(RowCountDest, 1).Value = xlSheetSource.Cells(RowCountSource, 1).Value
xlSheetDest.Cells(RowCountDest, 2).Value = CurValue02
End If
 
 
'Begin here to test debug in returning title time and student
 
CreditHourValue = ImpactVLookup(xlSheetSource.Cells(RowCountSource, 3), "A:C", xlImpactSheetDest)
 
If (InStr(CurValue02, "MOHITE, SANDEEP")) Then
xlDebug.Cells(DebugCounter, 1).Value = xlSheetSource.Cells(RowCountSource, 2).Value
xlDebug.Cells(DebugCounter, 2).Value = xlSheetSource.Cells(RowCountSource, 3).Value
xlDebug.Cells(DebugCounter, 3).Value = CreditHourValue
 
DebugCounter = DebugCounter + 1
 
End If
 
CurValue06 = xlSheetSource.Cells(RowCountSource, 6).Value
If (Len(CurValue06) > 0) Then
 
Select Case CurValue06
Case Is <= 0
xlSheetDest.Cells(RowCountDest, 4).Value = xlSheetDest.Cells(RowCountDest, 4).Value + 1
xlSheetDest.Cells(RowCountDest, 8).Value = xlSheetDest.Cells(RowCountDest, 8).Value + 1
RowCountOverdue = RowCountOverdue + 1
xlSheetOverdue.Cells(RowCountOverdue, 1).Value = xlSheetSource.Cells(RowCountSource, 2)
xlSheetOverdue.Cells(RowCountOverdue, 2).Value = xlSheetSource.Cells(RowCountSource, 3)
OverdueValue = CreditHourValue + OverdueValue
 
xlSheetOverdue.Cells(RowCountOverdue, 3).Value = xlSheetSource.Cells(RowCountSource, 4)
 
Case Is > 0
 
CurValue05 = xlSheetSource.Cells(RowCountSource, 5).Value
dueYear = DatePart("yyyy", CurValue05)
dueMonth = DatePart("m", CurValue05)
If ((thisYear = dueYear) And (thisMonth = dueMonth)) Then
xlSheetDest.Cells(RowCountDest, 5).Value = xlSheetDest.Cells(RowCountDest, 5).Value + 1
DueMonthValue = CreditHourValue + DueMonthValue
 
If (InStr(CurValue02, "MOHITE, SANDEEP")) Then
xlDebug.Cells(DebugCounter, 1).Value = xlSheetSource.Cells(RowCountSource, 2).Value
xlDebug.Cells(DebugCounter, 2).Value = xlSheetSource.Cells(RowCountSource, 3).Value
xlDebug.Cells(DebugCounter, 4).Value = "Month"
xlDebug.Cells(DebugCounter, 3).Value = CreditHourValue
 
DebugCounter = DebugCounter + 1
End If
 
ElseIf (CurValue05 < (thisDate + 60)) Then
xlSheetDest.Cells(RowCountDest, 6).Value = xlSheetDest.Cells(RowCountDest, 6).Value + 1
DueSixtyValue = CreditHourValue + DueSixtyValue
 
If (InStr(CurValue02, "MOHITE, SANDEEP")) Then
xlDebug.Cells(DebugCounter, 1).Value = xlSheetSource.Cells(RowCountSource, 2).Value
xlDebug.Cells(DebugCounter, 2).Value = xlSheetSource.Cells(RowCountSource, 3).Value
xlDebug.Cells(DebugCounter, 5).Value = "60 Days"
xlDebug.Cells(DebugCounter, 3).Value = CreditHourValue
 
DebugCounter = DebugCounter + 1
End If
 
ElseIf (CurValue05 < (thisDate + 90)) Then
xlSheetDest.Cells(RowCountDest, 7).Value = xlSheetDest.Cells(RowCountDest, 7).Value + 1
DueNinetyValue = CreditHourValue + DueNinetyValue
 
If (InStr(CurValue02, "MOHITE, SANDEEP")) Then
xlDebug.Cells(DebugCounter, 1).Value = xlSheetSource.Cells(RowCountSource, 2).Value
xlDebug.Cells(DebugCounter, 2).Value = xlSheetSource.Cells(RowCountSource, 3).Value
xlDebug.Cells(DebugCounter, 6).Value = "90 Days"
xlDebug.Cells(DebugCounter, 3).Value = CreditHourValue
 
DebugCounter = DebugCounter + 1
End If
 
ElseIf (thisYear = dueYear) Then
xlSheetDest.Cells(RowCountDest, 8).Value = xlSheetDest.Cells(RowCountDest, 8).Value + 1
DueYearValue = CreditHourValue + DueYearValue
 
If (InStr(CurValue02, "MOHITE, SANDEEP")) Then
xlDebug.Cells(DebugCounter, 1).Value = xlSheetSource.Cells(RowCountSource, 2).Value
xlDebug.Cells(DebugCounter, 2).Value = xlSheetSource.Cells(RowCountSource, 3).Value
xlDebug.Cells(DebugCounter, 7).Value = "Year"
xlDebug.Cells(DebugCounter, 3).Value = CreditHourValue
 
DebugCounter = DebugCounter + 1
End If
 
Else
xlSheetDest.Cells(RowCountDest, 9).Value = xlSheetDest.Cells(RowCountDest, 9).Value + 1
DueFutureValue = CreditHourValue + DueFutureValue
 
If (InStr(CurValue02, "MOHITE, SANDEEP")) Then
xlDebug.Cells(DebugCounter, 1).Value = xlSheetSource.Cells(RowCountSource, 2).Value
xlDebug.Cells(DebugCounter, 2).Value = xlSheetSource.Cells(RowCountSource, 3).Value
xlDebug.Cells(DebugCounter, 8).Value = "Future"
xlDebug.Cells(DebugCounter, 3).Value = CreditHourValue
 
DebugCounter = DebugCounter + 1
End If
 
End If
 
xlSheetDest.Cells(RowCountDest, 10).Value = xlSheetDest.Cells(RowCountDest, 10).Value + 1
DueTotalValue = CreditHourValue + DueTotalValue
 
Case Else
 
End Select
End If
 
Else
Exit For
End If
Next RowCountSource
 
 
' lookup supervisor for each student in report
 
For i = 2 To RowCountDest
 
xlSheetDest.Cells(i, 3).Value = RowVLookup(xlSheetDest.Cells(i, 2).Value, "B:N", xlSheetStudent)
 
Next i
 
 
 
 
xlSheetDest.Activate
For i = 2 To Counter
myRange1 = "B" & i
myRange2 = "B" & i & ":J" & i
Range(myRange1).Select
Selection.AutoFill Destination:=Range(myRange2), Type:=xlFillDefault
Next i
Columns("A:J").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
 
Range("A1:J1").Select
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Rows("1:1").RowHeight = 50
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
 
 
Range("A1:J" & RowCountDest).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A3").Select
 
 
' Insert Row Above Data compiled from first Macro
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
xlSheetDest.Cells(1, 1) = "Business Unit: " + xlSheetStudent.Cells(2, 7)
Range("D1").Select
 
' Insert Impact Data
 
 
xlSheetDest.Cells(1, 4) = OverdueValue
xlSheetDest.Cells(1, 5) = DueMonthValue
xlSheetDest.Cells(1, 6) = DueSixtyValue
xlSheetDest.Cells(1, 7) = DueNinetyValue
xlSheetDest.Cells(1, 8) = DueYearValue
xlSheetDest.Cells(1, 9) = DueFutureValue
xlSheetDest.Cells(1, 10) = OverdueValue + DueMonthValue + DueSixtyValue + DueNinetyValue + DueYearValue + DueFutureValue
 
 
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
 
xlSheetDest.Cells(1, 4) = "Overdue Hours"
xlSheetDest.Cells(1, 5) = "Next 30 Days"
xlSheetDest.Cells(1, 6) = "60 Days"
xlSheetDest.Cells(1, 7) = "90 Days"
xlSheetDest.Cells(1, 8) = "" & thisYear & ""
 
xlSheetDest.Activate
For i = 2 To Counter
myRange1 = "B" & i
myRange2 = "B" & i & ":J" & i
Range(myRange1).Select
Selection.AutoFill Destination:=Range(myRange2), Type:=xlFillDefault
Next i
 
Range("A1:J2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
 
Range("D1:J2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("K1").Select
 
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
 
Range("A1:J2").Select
Selection.Font.Bold = True
 
Range("D1:J2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
 
 
xlSheetDest.Cells(RowCountDest + 2, 3) = "Total"
xlSheetDest.Cells(RowCountDest + 2, 4) = "=SUM(D4:D" & RowCountDest & ")"
xlSheetDest.Cells(RowCountDest + 2, 5) = "=SUM(E4:E" & RowCountDest & ")"
xlSheetDest.Cells(RowCountDest + 2, 6) = "=SUM(F4:F" & RowCountDest & ")"
xlSheetDest.Cells(RowCountDest + 2, 7) = "=SUM(G4:G" & RowCountDest & ")"
xlSheetDest.Cells(RowCountDest + 2, 8) = "=SUM(H4:H" & RowCountDest & ")"
xlSheetDest.Cells(RowCountDest + 2, 9) = "=SUM(I4:I" & RowCountDest & ")"
 
 
xlBookSource.Close SaveChanges:=False
End Sub
 
Sub DeleteAllCode()
 
'Trust Access To Visual Basics Project must be enabled.
'From Excel: Tools | Macro | Security | Trusted Sources
 
Dim x As Integer
Dim Proceed As VbMsgBoxResult
Dim Prompt As String
Dim Title As String
 
'Prompt = "Are you certain that you want to delete all the VBA Code from " & ActiveWorkbook.Name & "?"
'Title = "Verify Procedure"
 
'Proceed = MsgBox(Prompt, vbYesNo + vbQuestion, Title)
'If Proceed = vbNo Then
'MsgBox "Procedure Canceled", vbInformation, "Procedure Aborted"
'Exit Sub
'End If
 
On Error Resume Next
With ActiveWorkbook.VBProject
For x = .VBComponents.Count To 1 Step -1
.VBComponents.Remove .VBComponents(x)
Next x
For x = .VBComponents.Count To 1 Step -1
.VBComponents(x).CodeModule.DeleteLines _
1, .VBComponents(x).CodeModule.CountOfLines
Next x
End With
On Error GoTo 0
End Sub
 
Call DeleteAllCode
PathName = ThisWorkbook.Path & "z:\\m...\...\..."
NewFileName = PathName & "\" & TargetYear & TargetSemester & " Weekly_Sheets " & TargetStudentType & ".xlsx"
 
' ThisWorkbook.BuiltinDocumentProperties("Comments") = ThisWorkbook.Name
 
 
' Create new file
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=NewFileName, _
FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
 
End Sub
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,961
Office Version
  1. 365
Platform
  1. Windows
:confused: entire code as requested, when did i do that?

I was trying to point out that it appears your code will already to what you're asking for help with, the original will retain the code, but the 'Save As' copies will not, is this not what you;re trying to achieve?
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,384
I think this one line of code will Save As your existing workbook without the macro code. No need to delete the code modules individually.

Code:
ActiveWorkbook.SaveAs Filename:=NewFileName, [COLOR="Red"]fileformat:=51[/COLOR]

The VBA SaveAs Method in Excel 2007

I don't understand what issue you have with PathName or FileName?
 

YoungOne

New Member
Joined
Mar 28, 2011
Messages
6
You're correct jasonb, the save as copies are to be code free after running the macro.

An Update:
Instead of having SubDeleteAll procedure contain the Save As,

Code:
PathName = ThisWorkbook.Path
    NewFileName = PathName & "\" & TargetYear & TargetSemester & " Weekly_Sheets " & TargetStudentType & ".xlsx"
 
    NewFileName = "X"
    Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=NewFileName, _
        FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        Application.DisplayAlerts = True
 
    Call DeleteAllCode

has been moved to be contained at the end the original procedure.. This logic is what I was after, save the workbook to a NewFileName, then Call the DeleteAllCode procedure to automatically clear the modules.

@AlphaFrog, Beginner's Frustrations..
I've come to understand the PathName and NewFile Name are correct as is.

Thank you for your time and considerations,
Young
 

Watch MrExcel Video

Forum statistics

Threads
1,122,910
Messages
5,598,803
Members
414,260
Latest member
joishe

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
Top