Error Trap Via Message

A

Ardy

Hello All:
I have this code that creates tabs from a list, my problem is that I
want to add to it, so it would prevent creating tab if the name already
exist and give a message, can anybody help me
---------------------------------------------------------
Private Sub CommandButton3_Click()
' Declair Variables
Dim iLastRow As Long, i As Long, sh As Worksheet, LastCell As Range
Dim Rng As Range, cell As Range, WS As Worksheet

' Start Create Student Tab From List in Column A Starting A2
With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
.Hyperlinks.Add Anchor:=Cells(i, "A"), _
Address:="", _
SubAddress:="'" & Cells(i, "A").Value &
"'!A1", _
TextToDisplay:=Cells(i, "A").Value
Next i
End With
'End Create Tab

' Start Creating Link From The List in Column A
' to The Student Tabs Starting FromCell A2
Set WS = ActiveSheet
Set LastCell = WS.Cells(Rows.Count, "A").End(xlUp)
Set Rng = WS.Range("A2", LastCell)

For Each cell In Rng
If Not IsEmpty(cell) Then
Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value
End If
Next
' End Creating Link

' Start Returning to Roster Tab
MakeVisible
Sheets("Template").Visible = False
Sheets("Template").Move Before:=Sheets(2)
Sheets("Roster").Select
Range("D2").Select
' Start Inserting formula for Transfering data to Roster
' module driven code
InsertInfoTransferFormula
CopyFormula
' End Inserting Formula For Transfering data to Roster
' Landing on Cell
Range("C1").Select
End Sub
----------------------------------------------------------------
 
D

Dave Peterson

One way...

dim testWks as worksheet
.....

For Each cell In Rng
If Not IsEmpty(cell) Then
set testwks = nothing
on error resume next
set testwks = worksheets(cell.value)
on error goto 0
if testwks is nothing then
'it doesn't exist
Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value
else
'already exists
end if
End If
Next
 
A

Ardy

Thank You,
I added your suggestion to the code works fine, Added the msgBox to
inform, one thing I was wondering how I would bring in the name of the
duplicate name in the message.
----------------------------------------------------
For Each cell In Rng
If Not IsEmpty(cell) Then
Set ExistWks = Nothing
On Error Resume Next
Set ExistWks = Worksheets(cell.Value)
On Error GoTo 0
If ExistWks Is Nothing Then
'it doesn't exist
Sheets("Template").Copy
after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value
Else
MsgBox "Name Already Exist"
End If
End If
Next
--------------------------------------------------------
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top