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 :doh:

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) (https://www.thespreadsheetguru.com/vba-alphabetically-sort-cell-range/)

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) (https://www.thespreadsheetguru.com/vba-alphabetically-sort-cell-range/)


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.