Creating New Sheets with Names from a List

Question

I am pretty new to VBA and am having an issue with my code. I have different hotel names from cell B4 to B27. My goal is to create new worksheets and name each one with the hotel names (going down the list). I tried running the sub procedure below but I am getting an error. The error says:

"Run-time error '1004': Application-defined or object-defined error"

It refers to the line below my comment. Any thoughts on why this is occurring and how I can fix this?

Sub sheetnamefromlist()

Dim count, i As Integer

count = WorksheetFunction.CountA(Range("B4", Range("B4").End(xlDown)))

i = 4

Do While i <= count

' next line errors
Sheets.Add(after:=Sheets(Sheets.count)).Name = Sheets("LocalList").Cells(i, 2).Text

i = i + 1

Loop

Sheets("LocalList").Activate

End Sub

First add the sheet and then `ActiveSheet.Name` to change the name. — cyboashu, Jul 23 '20 at 04:53
break the problem down. set a breakpoint on that line and examine the objects... — Mitch Wheat, Jul 23 '20 at 04:53
Sorry the website is not letting me bold it for some reason. It is the line with the two stars surrounding it. — youngyoda, Jul 23 '20 at 04:53

Siddharth Rout · Accepted Answer · 2020-07-23T05:49:32.480

Here is something that I quickly wrote

Few things

Do not find last row like that. You may want to see THIS
Do not use .Text to read the value of the cell. You may want to see What is the difference between .text, .value, and .value2?
Check if the sheet exists before trying to create one else you will get an error.

Is this what you are trying?

Option Explicit

Sub sheetnamefromlist()
    Dim ws As Worksheet, wsNew As Worksheet
    Dim lRow As Long, i As Long
    Dim NewSheetName As String
    
    '~~> Set this to the relevant worksheet
    '~~> which has the range
    Set ws = ThisWorkbook.Sheets("LocalList")
    
    With ws
        '~~> Find last row
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
        
        '~~> Loop through the range
        For i = 4 To lRow
            NewSheetName = .Cells(i, 2).Value2
            
            '~~> Check if there is already a worksheet with that name
            If Not SheetExists(NewSheetName) Then
                '~~> Create the worksheet and name it
                With ThisWorkbook
                    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = NewSheetName
                End With
            End If
        Next i
    End With
End Sub

'~~> Function to check if the worksheet exists
Private Function SheetExists(shName As String) As Boolean
    Dim shNew As Worksheet
    
    On Error Resume Next
    Set shNew = ThisWorkbook.Sheets(shName)
    On Error GoTo 0
    
    If Not shNew Is Nothing Then SheetExists = True
End Function

My assumptions

All cells have valid values i.e which can be used for sheet names. If not, then you will have to handle that error as well.
Workbook (not worksheet) is unprotected

Thank you for the clear explanation! Your code ran perfectly. I realized that the hotel names were over 31 characters so I will build in an error check in the future. Really appreciate the help Siddharth! — youngyoda, Jul 23 '20 at 06:03

score 0 · Answer 2 · answered Jul 23 '20 at 05:36

0

Try,

Sub test()
    Dim vDB As Variant
    Dim rngDB As Range
    Dim Ws As Worksheet, newWS As Worksheet
    Dim i As Integer
    
    Set Ws = Sheets("LocalList")
    With Ws
        Set rngDB = .Range("b4", .Range("b4").End(xlDown))
    End With
    vDB = rngDB 'Bring the contents of the range into a 2D array.
    
    For i = 1 To UBound(vDB, 1)
        Set newWS = Sheets.Add(after:=Sheets(Sheets.Count))
        newWS.Name = vDB(i, 1)
    Next i
End Sub

answered Jul 23 '20 at 05:36

Dy.Lee

7,527
1
12
14

The code ran perfectly. Thank you! My error was in the length of the hotel name and also the usage of symbols such as "/". – youngyoda Jul 23 '20 at 06:06

score 0 · Answer 3 · answered Jul 23 '20 at 06:44

Create Worksheets from List

The following will create (and count) only worksheets with valid names.
When the worksheet is already added and the name is invalid, it will be deleted (poorly handled, but it works.)
It is assumed that the list is contiguous (no empty cells).

The Code

Option Explicit

Sub SheetNameFromList()

    Const wsName As String = "LocalList"
    Const FirstCell As String = "B4"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim ListCount As Long
    ListCount = WorksheetFunction.CountA(ws.Range(FirstCell, _
                                         ws.Range(FirstCell).End(xlDown)))
    Dim fRow As Long: fRow = ws.Range(FirstCell).Row
    Dim fCol As Long: fCol = ws.Range(FirstCell).Column
    Dim i As Long, wsCount As Long
    
    Do While i < ListCount
        If addSheetAfterLast(wb, ws.Cells(fRow + i, fCol).Value) = True Then
            wsCount = wsCount + 1
        End If
        i = i + 1
    Loop
   
    ws.Activate
    MsgBox "Created " & wsCount & " new worksheet(s).", vbInformation
    
End Sub

Function addSheetAfterLast(WorkbookObject As Workbook, _
                       SheetName As String) _
         As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = WorkbookObject.Worksheets(SheetName)
    If Err.Number = 0 Then Exit Function
    Err.Clear
    WorkbookObject.Sheets.Add After:=WorkbookObject.Sheets(Sheets.count)
    If Err.Number <> 0 Then Exit Function
    Err.Clear
    WorkbookObject.ActiveSheet.Name = SheetName
    If Err.Number <> 0 Then
        Application.DisplayAlerts = False
        WorkbookObject.Sheets(WorkbookObject.Sheets.count).Delete
        Application.DisplayAlerts = False
        Exit Function
    End If
    addSheetAfterLast = True
End Function

Thanks! Appreciate the guidance. – youngyoda Jul 23 '20 at 20:27 — youngyoda, Jul 23 '20 at 20:27

Creating New Sheets with Names from a List

3 Answers3

Create Worksheets from List