Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Create & Name new Sheets without duplicates

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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default Create & Name new Sheets without duplicates

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.



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
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Create & Name new Sheets without duplicates

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





Dave Peterson wrote:
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.



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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Highlighting duplicates across many sheets jpeevy Excel Worksheet Functions 3 January 20th 12 06:20 AM
Need Help with Highlighting duplicates across several sheets vote4pedro Excel Worksheet Functions 1 September 1st 08 10:05 PM
counting duplicates Among Many Sheets, Possible?? Mhz New Users to Excel 5 July 5th 06 02:23 AM
Deleting duplicates across sheets p. 2 jimmy[_2_] Excel Programming 1 September 27th 03 03:57 PM
Deleting duplicates across sheets jimmy[_2_] Excel Programming 4 September 26th 03 08:08 PM


All times are GMT +1. The time now is 10:45 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"