PDA

View Full Version : New Sheets Based on Cell Info



dolver
12-28-2007, 01:04 PM
So I am trying to create code that will read A2:A271 and create a new sheet with the name of the data in each of those cells (so I end up with 270 new sheets). I have found the following code:

Sub AddSheetWithNameCheckIfExists()
Dim ws As Worksheet
Dim newSheetName As String
newSheetName = Sheets(1).Range("A1") ' Substitute your range here
For Each ws In Worksheets
If ws.Name = newSheetName Or newSheetName = "" Or IsNumeric(newSheetName) Then
MsgBox "Sheet already exists or name is invalid", vbInformation
Exit Sub
End If
Next
Sheets.Add Type:="Worksheet"
With ActiveSheet
.Move after:=Worksheets(Worksheets.Count)
.Name = newSheetName
End With
End Sub
And I can get it to work for one cell at a time, but how do I make it loop and do every cell in column A? Thanks.

Dave O

MWE
12-28-2007, 01:48 PM
you need to wrap your current code with a loop that sequences through the target cells, i.e., A2 to A272. There are lots of ways to do this and several subtle variations that may make sense. One approach:

Sub AddSheetWithNameCheckIfExists()
Dim I as long
Dim xlTargetSheet as worksheet
Dim ws As Worksheet
Dim newSheetName As String

Set xlTargetSheet = activesheet ' or ... = Worksheets("SheetName") if not activesheet when procedures starts
For I = 2 to 272
newSheetName = xlTargetSheet.cells(I,1)
For Each ws In Worksheets
If ws.Name = newSheetName Or newSheetName = "" Or IsNumeric(newSheetName) Then
MsgBox "Sheet already exists or name is invalid", vbInformation
Exit Sub ' or you may wish to have procedure alter the name slightly or have user enter some other name or ...
End If
Next
Sheets.Add Type:="Worksheet"
With ActiveSheet
.Move after:=Worksheets(Worksheets.Count)
.Name = newSheetName
End With
Next I
CleanUp:
set ws = Nothing
Set xlTargetSheet = Nothing
End Sub
this should do the basic job. The patched together code is a bit verbose and could be cleaned up a bit. Further, you may wish to check for a few other issues like invalid sheet name characters (some special characters can not be used in sheet names) and add some code to keep track of what was actually done and, for instance, post something to the target sheet to indicate that the new worksheets were actually added.

BTW, the "Nothing" stuff at the bottom is "good housekeeping practice"

Let us know if this works for you and if you need further help cleaning this up and doing a few more things.

dolver
12-28-2007, 02:48 PM
Wow! That worked like a charm! Thanks so much.

Bob Phillips
12-28-2007, 03:22 PM
You can do that without looping all sheets to check existence



Sub AddSheetWithNameCheckIfExists()
Dim i As Long
Dim ws As Worksheet
Dim newSheetName As String

With ActiveSheet

For i = 2 To 272
newSheetName = .Cells(i, 1).Value
If newSheetName = "" Or IsNumeric(newSheetName) Then

MsgBox "Sheet name " & newSheetName & " is invalid", vbInformation
Exit Sub
Else

Set ws = Nothing
On Error Resume Next
Set ws = Worksheets(newSheetName)
On Error GoTo 0
If ws Is Nothing Then Worksheets.Add( _
after:=Worksheets(Worksheets.Count)).Name = newSheetName
End If
Next i

.Activate
End With

Set ws = Nothing
End Sub

MWE
12-28-2007, 04:42 PM
Wow! That worked like a charm! Thanks so much.Glad to help.

As xld suggests and demonstrated, there is much tighter and cleaner code. However, I often find that people new to this stuff prefer slightly more obvious steps and less elegant code (what I often call "brute force").

If either of these solutions is adequate, please mark this thread as solved. If you want to expland the capability of the procedure along the lines I suggested in my earlier reply, post back with what else you might want to do.