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.
(E-Mail Removed) wrote:
>
> 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
Similar Threads
