Need help: debug/fix VBA code to create new worksheets from template and names list

[Ruede]

Hi Everyone


I would really appreciate some help with debugging the attached VBA code (created in Excel 2021) and getting the last sorting function to work.


The purpose of the code is to:
(1) create new worksheets based on a template (named aa_template) and with names that correspond to the list in the first column of the active worksheet (aa_Master),
and then...
(2) sort the worksheets alphabetically.


The code mostly works. It creates new worksheets based on the template and list of names, but... it :
- throws up an "Execution error 1004: Name' method of object '_Worksheet' failed" and halts
- does not sort the worksheets alphabetically.


Thankyou in advance


Ruede

-----------

Sub Create()
    Dim myArray As Variant, rng As Range, rngLoop As Range, ws As Worksheet, ShCount As Integer, i As Integer, j As Integer
 
    'Error warning: missing template
    If Not SheetExists("aa_Template") Then
        MsgBox "The Template sheet does not exist. Make sure the Template is included before processing.", vbCritical + vbOKOnly
        Exit Sub
    End If
    
    'Optimise code
    Application.ScreenUpdating = False
    
       
    'Create new worksheets from names in first column of aa_Master worksheet
    With ActiveWorkbook.Sheets("aa_Master")
        Set rng = .Range("B2", "B" & .Cells(Rows.Count, "B").End(xlUp).Row)
        For Each rngLoop In rng
            If Not SheetExists(rngLoop.Value) Then
                ActiveWorkbook.Sheets("aa_Template").Copy after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
                Set ws = ActiveSheet
                ws.Name = rngLoop.Value
            Else
                Set ws = ActiveWorkbook.Sheets(rngLoop.Value)
            End If
        Next
        .Activate
    End With
    
    'Sort worksheets alphabetically
    ShCount = Sheets.Count


        For i = 1 To ShCount - 1
        For j = i + 1 To ShCount
             If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then
             Sheets(j).Move before:=Sheets(i)
             End If
        Next j
        Next i
     
    Application.ScreenUpdating = True
    
End Sub


Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
   Dim sht As Worksheet


    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    SheetExists = Not sht Is Nothing
End Function

[Aussiebear]

Welcome to VBAX Ruede. I notice that you have suggested that the new workbooks are to be based, on the first active column of the template, but the code is suggesting that you are using Column 2. Is this a typo?

[Ruede]

Welcome to VBAX Ruede. I notice that you have suggested that the new workbooks are to be based, on the first active column of the template, but the code is suggesting that you are using Column 2. Is this a typo?

Not a typo - just an inadequate explanation on my part

Over time, new entries are going to be added to the first column.
However, because the Excel user interface forbids worksheet names longer than 31 characters, I added a formula to the second column to restrict the length to 31. This is why the VBA code looks here for the names for the worksheets.

[jdelano]

Why not sort the range containing the sheet names alphabetically before adding the sheets?
Alphabetically Sort Cell Range Values With VBA Code (thespreadsheetguru.com)

EDIT:
As to the error, this line

ws.Name = rngLoop.Value

is giving the error because rngLoop.Value equals "". A sheet must have a name. This statement

Set rng = .Range("B2", "B" & .Cells(Rows.Count, "B").End(xlUp).Row)

is returning 19 cells (screenshot https://imgur.com/E9O0J4R) because of the If statement in the formula. You can add

If rngLoop.Value = "" Then Exit For

under the For each line to stop looping when you encounter this.

EDIT2: the code that works for me

    Dim rng As Range, rngLoop As Range, ws As Worksheet, lo As ListObject
    
    'Create new worksheets from names in first column of aa_Master worksheet
    With ActiveWorkbook.Sheets("aa_Master")
        Set lo = .ListObjects(1)  ' the data in this sheet is a table
        lo.Range.Sort key1:=Range("B2")
    
        Set rng = .Range("B2", "B" & .Cells(Rows.Count, "B").End(xlUp).Row)
        For Each rngLoop In rng
            If rngLoop.Value = "" Then Exit For   ' a cell that is blank has been encountered, end the loop
            If Not SheetExists(rngLoop.Value) Then
                ActiveWorkbook.Sheets("aa_Template").Copy after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
                Set ws = ActiveSheet
                ws.Name = rngLoop.Value
            Else
                Set ws = ActiveWorkbook.Sheets(rngLoop.Value)
            End If
        Next
        .Activate
    End With

[Ruede]

As to the error, this line

ws.Name = rngLoop.Value

is giving the error because rngLoop.Value equals "". A sheet must have a name. This statement

Set rng = .Range("B2", "B" & .Cells(Rows.Count, "B").End(xlUp).Row)

is returning 19 cells (screenshot https://imgur.com/E9O0J4R) because of the If statement in the formula. You can add

If rngLoop.Value = "" Then Exit For

under the For each line to stop looping when you encounter this.

Jdealano - you are a genius my friend. Adding that line to my code makes it run perfectly!!
Thanks!!

[Ruede]

Why not sort the range containing the sheet names alphabetically before adding the sheets?
Alphabetically Sort Cell Range Values With VBA Code (thespreadsheetguru.com)

When the code is run it creates a list of worksheets in alphabetic order. When new entries are added and the code is run again, there is an instruction to do nothing when a list name matches an existing worksheet (ie. to prevent existing worksheets that contain data from being over-written).

So, if a new name that precedes the existing list of names alphabetically is added, only one new worksheet is actually created and it is placed at the end (ie. not in alphabetic order overall). For this reason I put the sort function at the end. Hope that makes sense.

[jdelano]

I see.