I'm trying to add functionality to my spreadsheet that takes a lis
present on the main worksheet page, of undeterminate length (but no
infinite -- maybe 10 or 15 at most), and, if the worksheets do no
already exist, creates an individual worksheet for each item on th
list.

The list consists of different names, with a heading, like so:
Vendor:
Tribune
Times
Sentinel
Tribune
Sentinel
Post
Times
Tribune

etc., and the names may vary.

I wrote some code to try and do this, and have gotten as far a
creating new sheets in the correct number (thus my loop is correct, an
I'd assume my identifying cells is correct) but it does not correctl
rename the sheets (and thus creates too many sheets). I only want on
sheet per name (even if the name repeats, as it will likely). So, if
have 7 names (after "Vendor:") but only 4 unique names (3 repeats) i
creates seven new worksheets named "Sheet1" to "Sheet7". Not sure wh
the name isn't working ...

here's my code so far:
(Important part first, then the entire thing)

Code
-------------------

Do Until ((Left(wksData.Cells(intRow, VendorCol), 3) = "End") Or (intRow 30))
If (Left(wksData.Cells(intRow, VendorCol), 4) = "Vend") Then
Set wks = Worksheets(wksData.Cells(intRow, VendorNameCol).Value)
If Err 0 Or wks Is Nothing Then
Err.Clear
Worksheets.Add after:=Worksheets(Worksheets.Count)
Range("A1") = wksData.Cells(intRow, VendorNameCol).Value
ActiveSheet.Name = wksData.Cells(intRow, VendorNameCol)
MsgBox "I created a sheet"
End If
End If
intRow = intRow + 1
Loop

-------------------


Entire Thing:


Code
-------------------

Sub WorksheetCreating()
Dim wks As Worksheet, wksData As Worksheet
Dim intRow As Integer, intRowL As Integer
Dim strSheet As String
Application.ScreenUpdating = False
Worksheets("NewspaperLog").Activate
Set wksData = ActiveSheet
Dim VendorCol As Integer, VendorNameCol As Integer
VenderNameCol = 16 'this is the column that the actual name is in
VendorCol = 15 ' this is the column of "Vendor", with the word "Vendor" in every cell in 15 that has a vendor name in 16
intRow = 3
ActiveSheet.Name = "NewspaperLog"
On Error Resume Next
MsgBox "We got here ok 0"
Do Until ((Left(wksData.Cells(intRow, VendorCol), 3) = "End") Or (intRow 30))
If (Left(wksData.Cells(intRow, VendorCol), 4) = "Vend") Then
Set wks = Worksheets(wksData.Cells(intRow, VendorNameCol).Value)
If Err 0 Or wks Is Nothing Then
Err.Clear
Worksheets.Add after:=Worksheets(Worksheets.Count)
Range("A1") = wksData.Cells(intRow, VendorNameCol).Value
ActiveSheet.Name = wksData.Cells(intRow, VendorNameCol)
MsgBox "I created a sheet"
End If
End If
intRow = intRow + 1
Loop

MsgBox "We Got here ok 1"
On Error GoTo 0
Worksheets(2).Select
intRow = 3
' don't forget to put the data copying stuff here
MsgBox "We Got Here ok 2"
Application.ScreenUpdating = True
End Sub

-------------------


--
Message posted from http://www.ExcelForum.com