Search code examples
excelvbaadditionincrementworksheet-function

VBA Excel Incremented worksheet name Add After Statement using a stored variable sheet name


How to add a worksheet in excel with VBA after a specific sheetname held by variable?

I tried: Set sh = wb.Worksheets.Add(After:=wb.Sheets(wsPattern & CStr(n)))

The previous incremented sheetname is stored in "wsPattern & CStr(n)", The new sheetname increments up properly from another statement and variable, but the add after fails with the above syntax. I'm getting an out of range error at this line.

The code fully executes using this statement, but adds any newly created sheets from any given series at the end of all sheets: Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))

As the workbook has 4 series of sheet names now (e.g. Test1, logistic1, Equip1, Veh1, etc.) that are incremented up as they are added, the next incremented sheet for a given series needs to be added to the end of that sheet name series (Equip2 should be after Equip1) and not at the end of all sheets.

    Sub CreaIncWkshtEquip()
    
    Const wsPattern As String = "Equip "
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim arr() As Long: ReDim arr(1 To wb.Sheets.Count)
    Dim wsLen As Long: wsLen = Len(wsPattern)
    Dim sh As Object
    Dim cValue As Variant
    Dim shName As String
    Dim n As Long
    
    For Each sh In wb.Sheets
        shName = sh.Name
        If StrComp(Left(shName, wsLen), wsPattern, vbTextCompare) = 0 Then
            cValue = Right(shName, Len(shName) - wsLen)
            If IsNumeric(cValue) Then
                n = n + 1
                arr(n) = CLng(cValue)
            End If
        End If
    Next sh
    If n = 0 Then
        n = 1
    Else
        ReDim Preserve arr(1 To n)
        For n = 1 To n
            If IsError(Application.Match(n, arr, 0)) Then
                Exit For
            End If
        Next n
    End If
    
    'adds to very end of workbook
    'Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    
    'Test-Add After Last Incremented Sheet-
    Set sh = wb.Worksheets.Add(After:=wb.Sheets(wsPattern & CStr(n)))
       
    sh.Name = wsPattern & CStr(n)
End Sub 

Solution

  • Create a function

    Sub Demo()
       Dim s
       s = AddSheet("SeriesName")
       MsgBox s & " Added"
    End Sub
    
    Function AddSheet(sSeries As String) As String
    
        Dim ws, s As String, i As Long, n As Long
        With ThisWorkbook
            ' find last in series
            For n = .Sheets.Count To 1 Step -1
                s = .Sheets(n).Name
                If s Like sSeries & "[1-9]*" Then
                    i = Mid(s, Len(sSeries) + 1)
                    Exit For
                End If
            Next
            ' not found add to end
            If i = 0 Then
               n = .Sheets.Count
            End If
            ' increment series
            s = sSeries & i + 1
            .Sheets.Add after:=.Sheets(n)
            .Sheets(n + 1).Name = s
        End With
        AddSheet = s
    
    End Function