Alright. I am working on a VBA code that will create a new worksheet rename it and format based on a cell range date and also create an error message if a worksheet with the date already exists.
The problem I am having is that when I click the button assigned to the macro I will receive the error message regardless if the worksheet name exists or not, and if it exists it will create a new worksheet named Production Board (2). What I want it to do is end the macro if the sheet name already exists, and not show the error message if the sheet name does not exist.
Here is the current code that I have. Any help is very much appreciated.
Sheets("Production Board").Select
Sheets("Production Board").copy Before:=Sheets(1)
Dim wSheet As Worksheet
On Error Resume Next
For Each wSheet In Worksheets
If wSheet.Range("D4") = "" Then
wSheet.Name = "Sheet" & wSheet.Index
Else
wSheet.Name = Format(wSheet.Range("D4"), "mm-dd-yyyy")
End If
Next
If Err Then
MsgBox "This Archival Date Already Exists"
Exit Sub
End If
Application.Run "'Production Tracking Archive.xls'!Unprotect"
ActiveSheet.Shapes("Text Box 1").Select
Selection.delete
ActiveSheet.Shapes("Text Box 4").Select
Selection.delete
ActiveSheet.Shapes("Text Box 5").Select
Selection.delete
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.Unprotect
Range("D4").Select
Selection.Locked = True
Selection.FormulaHidden = False
Range("E4").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("E15").Select
Sheets("Production Board").Select
Range("C6:I8").Select
Application.Run "'Production Tracking Archive.xls'!Unprotect"
Range("C6:I8,C10:I12,C14:I16,C21:I23").Select
Range("C21").Activate
Selection.ClearContents
Range("D4").Select
Application.Run "'Production Tracking Archive.xls'!Protect"
End Sub
The problem I am having is that when I click the button assigned to the macro I will receive the error message regardless if the worksheet name exists or not, and if it exists it will create a new worksheet named Production Board (2). What I want it to do is end the macro if the sheet name already exists, and not show the error message if the sheet name does not exist.
Here is the current code that I have. Any help is very much appreciated.
Sheets("Production Board").Select
Sheets("Production Board").copy Before:=Sheets(1)
Dim wSheet As Worksheet
On Error Resume Next
For Each wSheet In Worksheets
If wSheet.Range("D4") = "" Then
wSheet.Name = "Sheet" & wSheet.Index
Else
wSheet.Name = Format(wSheet.Range("D4"), "mm-dd-yyyy")
End If
Next
If Err Then
MsgBox "This Archival Date Already Exists"
Exit Sub
End If
Application.Run "'Production Tracking Archive.xls'!Unprotect"
ActiveSheet.Shapes("Text Box 1").Select
Selection.delete
ActiveSheet.Shapes("Text Box 4").Select
Selection.delete
ActiveSheet.Shapes("Text Box 5").Select
Selection.delete
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.Unprotect
Range("D4").Select
Selection.Locked = True
Selection.FormulaHidden = False
Range("E4").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("E15").Select
Sheets("Production Board").Select
Range("C6:I8").Select
Application.Run "'Production Tracking Archive.xls'!Unprotect"
Range("C6:I8,C10:I12,C14:I16,C21:I23").Select
Range("C21").Activate
Selection.ClearContents
Range("D4").Select
Application.Run "'Production Tracking Archive.xls'!Protect"
End Sub