Create & Name new Sheets without duplicates

[hughaskew2]

Need to create new worksheets from a template ws, then name them from a
list on a sheet called "CatNames".
The sub below from Dave P. works fine, except i would like to avoid
creating duplicate sheets.
If my list in Col A contains 12 names, i insert the new worksheets.
that works fine. if i add 8 names to the list tomorrow, i need to
create ONLY the 8 new sheets. make sense?

any help offered will be gladly received.
Many TIA

Sub CreateNameSheets()
' by Dave Peterson

Dim TemplateWks As Worksheet
Dim ListWks As Worksheet
Dim ListRng As Range
Dim myCell As Range

Set TemplateWks = Worksheets("qwerty")
Set ListWks = Worksheets("CatNames")
With ListWks
Set ListRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In ListRng.Cells
TemplateWks.Copy after:=Worksheets(Worksheets.Count)
On Error Resume Next
ActiveSheet.Name = myCell.Value
If Err.Number <> 0 Then
MsgBox "Duplicate Worksheet " & ActiveSheet.Name
Err.Clear
End If
On Error GoTo 0
Next myCell

End Sub

 

[Dave Peterson]

Check to see if a worksheet with that name exists before adding it:

Option Explicit
Sub CreateNameSheets()
' by Dave Peterson

Dim TemplateWks As Worksheet
Dim ListWks As Worksheet
Dim ListRng As Range
Dim myCell As Range
dim Wks as worksheet
dim resp as long

Set TemplateWks = Worksheets("qwerty")
Set ListWks = Worksheets("CatNames")
With ListWks
Set ListRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In ListRng.Cells
set wks = nothing
on error resume next
set wks = worksheets(mycell.value)
on error goto 0
if wks is nothing then
'doesn't exist, so add it
TemplateWks.Copy _
after:=Worksheets(Worksheets.Count)
on error resume next
ActiveSheet.Name = myCell.Value
if err.number <> 0 then
'delete it?
application.displayalerts = false
activesheet.delete
application.displayalerts = true
err.clear
end if
else
beep
'or
msgbox mycell.value & " already exists"
end if
Next myCell

End Sub

I deleted the newly added sheet if the name was invalid.

 

[hughaskew2]

Dave - MANY Thanks! works like unto a treat!!!
Happy NW