Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Create a new worksheet based on variable cell date. 1

Status
Not open for further replies.

Mbradb

IS-IT--Management
Dec 12, 2008
6
US
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
 
Hi,

Add a watch on err.number and strp thru your code. In the loop, you will see the error when it occurs and then you can make a control statement to avoid the error.

faq707-4594

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top