Below is a code that creates a worksheet. How would I get
it to display the error "Duplicate Sheet" and then exit
the sub if it detects a sheet with the name of the sheet
it is trying to create?

Right now if the name of the sheet already exsists when
the code trys to create a sheet I get the error "Run time
error 1004
Cannot rename a sheet to the same name as another sheet,
etc..."

Thanx

Todd

Dim sha As Worksheet
Dim shar As Worksheet

Set sha = Worksheets(1)
'Set shar = ActiveWorkbook.Worksheets.Add
With ActiveWorkbook.Worksheets
Set shar = .Add(after:=.Item(.Count))
End With

sha.Cells.Copy

shar.Cells.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

shar.Cells.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

shar.Name = sha.Range("E2").Value
shar.Range("A2").Select

ActiveWindow.DisplayZeros = False
Worksheets(1).Select

Before you try adding the sheet, check to see if it's there.

You could do it inline:

dim TestWks as worksheet

set testwks = nothing
on error resume next
set testwks = worksheets(sha.Range("E2").Value)
on error goto 0

if testwks is nothing then
'everything is ok and continue
else
msgbox "already exists warning message"
exit sub '???
end if

(right before you try to add it.)

If you do it lots of times, you may want to use a function:

A post by Chip Pearson that I've saved:

Function WorksheetExists(SheetName As String, _
Optional WhichBook As Workbook) As Boolean
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = Len(WB.Worksheets(SheetName).Name) 0
End Function

You can then call this function in code as follows:

If WorksheetExists("Sheet123") = True Then
' sheet exists
Else
' sheet does not exist
End If

=======
So you could use:

if worksheetexists(sha.Range("E2").Value) then
.....


Todd Huttenstine wrote:

Below is a code that creates a worksheet. How would I get
it to display the error "Duplicate Sheet" and then exit
the sub if it detects a sheet with the name of the sheet
it is trying to create?

Right now if the name of the sheet already exsists when
the code trys to create a sheet I get the error "Run time
error 1004
Cannot rename a sheet to the same name as another sheet,
etc..."

Thanx

Todd

Dim sha As Worksheet
Dim shar As Worksheet

Set sha = Worksheets(1)
'Set shar = ActiveWorkbook.Worksheets.Add
With ActiveWorkbook.Worksheets
Set shar = .Add(after:=.Item(.Count))
End With

sha.Cells.Copy

shar.Cells.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

shar.Cells.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

shar.Name = sha.Range("E2").Value
shar.Range("A2").Select

ActiveWindow.DisplayZeros = False
Worksheets(1).Select

--

Dave Peterson

It doesnt seem to be working. What am I doing wrong?


Private Sub CommandButton1_Click()
If MsgBox("This will save " & Worksheets(1).Range
("E2").Value & _
" Stats as New Worksheet named " & Worksheets(1).Range
("E2").Value & _
". Are you sure?", vbYesNo) = vbNo Then
Exit Sub
End If

Dim sha As Worksheet
Dim shar As Worksheet


Dim TestWks As Worksheet

Set TestWks = Nothing
On Error Resume Next
Set TestWks = Worksheets(sha.Range("E2").Value)
On Error GoTo 0

If TestWks Is Nothing Then
'everything is ok and continue
Else
MsgBox "already exists warning message"
Exit Sub '???
End If




Set sha = Worksheets(1)
'Set shar = ActiveWorkbook.Worksheets.Add
With ActiveWorkbook.Worksheets
Set shar = .Add(after:=.Item(.Count))
End With

sha.Cells.Copy

shar.Cells.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

shar.Cells.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

shar.Name = sha.Range("E2").Value
shar.Range("A2").Select

ActiveWindow.DisplayZeros = False
Worksheets(1).Select

If MsgBox("Sheet Created Successfully. Would you like
to save Workbook?", vbYesNo) = vbNo Then
Exit Sub
End If

ActiveWorkbook.Save
End Sub

I got it. I failed to put the below part of the code
above the rest of the code.

Set TestWks = Nothing

Thanx

Thats very useful.

-----Original Message-----
It doesnt seem to be working. What am I doing wrong?


Private Sub CommandButton1_Click()
If MsgBox("This will save " & Worksheets(1).Range
("E2").Value & _
" Stats as New Worksheet named " & Worksheets(1).Range
("E2").Value & _
". Are you sure?", vbYesNo) = vbNo Then
Exit Sub
End If

Dim sha As Worksheet
Dim shar As Worksheet


Dim TestWks As Worksheet

Set TestWks = Nothing
On Error Resume Next
Set TestWks = Worksheets(sha.Range("E2").Value)
On Error GoTo 0

If TestWks Is Nothing Then
'everything is ok and continue
Else
MsgBox "already exists warning message"
Exit Sub '???
End If




Set sha = Worksheets(1)
'Set shar = ActiveWorkbook.Worksheets.Add
With ActiveWorkbook.Worksheets
Set shar = .Add(after:=.Item(.Count))
End With

sha.Cells.Copy

shar.Cells.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

shar.Cells.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

shar.Name = sha.Range("E2").Value
shar.Range("A2").Select

ActiveWindow.DisplayZeros = False
Worksheets(1).Select

If MsgBox("Sheet Created Successfully. Would you
like
to save Workbook?", vbYesNo) = vbNo Then
Exit Sub
End If

ActiveWorkbook.Save
End Sub
.