Dynamic Sheet Construction/Naming

[jclauson]

Hello all,

Today's my first day using VBA; I'm trying to automate a somewhat mundane task for work.

I have a certain number of groups each with their own length, and I'd like to have a macro that creates a separate sheet for each element in each group, and renames it.

The sheet name should correspond to its group number followed by its own number within the group, i.e. if I have three groups with two elements in each group, the sheet naming would be:

1-1, 1-2, 2-1, 2-2, 3-1, 3-2

The first sheet needs to be exempt from this, so the automatic renaming of sheets should start from sheet #2.

I've written some code that mostly works just fine:

Sub シート名数字順()
    Dim i As Integer
    Dim j As Integer
    Dim categories: categories = Array(11, 14) '各分類のサイズ
    Dim sheetNum As Integer: sheetNum = 2
    Dim catCount As Integer: catCount = 1
    
    '必要になるシート数の計算
    Dim neededSheetCount As Integer: neededSheetCount = 0
    For Each cat In categories
        neededSheetCount = neededSheetCount + cat
    Next
    
    'シート数足りてなければ足りない分を追加
    If Sheets.Count < neededSheetCount Then
        Dim sc As Integer: sc = Sheets.Count
        For j = sc To neededSheetCount
            Sheets.Add After:=Sheets(Sheets.Count)
        Next j
    End If
    
    '名前変更
    For Each cat In categories
        For i = 1 To cat
            Sheets(sheetNum).Name = catCount & "-" & i
            sheetNum = sheetNum + 1
        Next i
        catCount = catCount + 1
    Next
End Sub

The idea is to provide the groups and their sizes in the "categories" array, find out if any additional sheets need to be made based on the current amount of sheets, then rename the sheets according to their group.

The renaming works fine, and if I were to add a group (i.e. categories = Array(11, 14, 3) ), the additional sheets would be made and renamed without issue.

The only problem arises when I increase the size of a pre-existing group (i.e. Array(11, 14) to Array(11, 15) )

For some reason this returns "Subscript out of range (Error 9)"

Does anybody know what's going wrong?

 

[Peter_SSs]

Welcome to the MrExcel board!

Rather than working out how many extra sheets you need, would it be acceptable to simply remove any sheets after the first and then and and name all the required sheets in one go?

Also, you will note that I have changed your 'Integer' Dim statements to 'Long' since vba converts all Integers to Long before using them anyway.

If the deletion is acceptable, then try this with a copy of your workbook.

Sub Test()
    Dim i As Long
    Dim categories: categories = Array(11, 14) '???????
    Dim catCount As Long
    Dim cat As Variant
    
    Application.ScreenUpdating = False
    'Remove excess sheets
    If Sheets.Count > 1 Then
      Application.DisplayAlerts = False
      For i = Sheets.Count To 2 Step -1
        Sheets(i).Delete
      Next i
      Application.DisplayAlerts = True
    End If
    
    'Add and name the new sheets
    For Each cat In categories
        catCount = catCount + 1
        For i = 1 To cat
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = catCount & "-" & i
        Next i
    Next cat
    Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

would it be acceptable to simply remove any sheets after the first and then and and name all the required sheets in one go?

Ahh, on re-reading I think the following might preclude that? The existing sheets may already have data in them?

The only problem arises when I increase the size of a pre-existing group (i.e. Array(11, 14) to Array(11, 15) )

 

[StephenCrump]

You're numbering your sheets starting with the second sheet, so you need to check that you have neededSheetCount + 1 sheets

That's why your code fails when you increase the number of sheets by only 1, e.g. from (11,14) --> (11,15).

As @Peter_SSs indicates, there are smarter ways to do this, e.g. by looping through and creating new sheets only if necessary. This will avoid renaming sheets that may have data on already.

 

[Peter_SSs]

Here is an alternative to try that preserves existing sheets and only adds the new ones required. It also sorts them all by their groups.

Sub Test_v2()
    Dim i As Long
    Dim categories: categories = Array(11, 14) '???????
    Dim catCount As Long
    Dim cat As Variant
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    'Add, name and sort new sheets
    For Each cat In categories
        catCount = catCount + 1
        For i = 1 To cat
          Set ws = Nothing
          On Error Resume Next
          Set ws = Sheets(catCount & "-" & i)
          On Error GoTo 0
          If ws Is Nothing Then
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = catCount & "-" & i
          Else
            ws.Move After:=Sheets(Sheets.Count)
          End If
        Next i
    Next cat
    Application.ScreenUpdating = True
End Sub

 

[jclauson]

Thanks for your help, @Peter_SSs and @StephenCrump
Using the second batch of code Peter posted solved my problem, and it looks a lot nicer to take care of all the logic in one loop.
Thanks again for the help!

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.