CODEWITHSUNDEEP
excelvba
Geographos
Geographos

Reputation: 1456

VBA Excel add new sheet with number based on the previous sheet created

I have the Sheet called "Area Map 1". I want to create the button, which will add the new sheet for me (copy the "Area Map 1") with the name Area Map 2. The button is going to add one sheet only. It means, that it can be used repeatedly if we need to create more sheets. However, if I use this button once, then my last existing sheet under this name is "Area Map 2". Using the button again will result from the error "The name is already taken, try the different one".

enter image description here

What should I improve in the code below then?

  Sub ConsecutiveNumberSheets()
  Dim ws As Worksheet
  Dim i As Long
  For i = 1 To Sheets.Count - (Sheets.Count - 1)
  With Sheets("Area Map 1")
  .Copy after:=ActiveSheet
  ActiveSheet.Name = "Area Map " & (i + 1)
  .Select
  End With
  Next i
  End Sub

I want something, which will detect, that the new sheet with incremented numbers is already created. What should I do to base my code on the last number of the already existing sheets?

Upvotes: 1

Views: 1096

Answers (2)

3xGuy
3xGuy

Reputation: 2559

this should do what you're looking for.

Public Sub CreateSheet()
    Dim wb As Workbook: Set wb = ActiveWorkbook
    Dim ws As Worksheet
    Dim startName As String: startName = "Area Map "
    Dim counter As Integer: counter = 1
    
    For Each ws In wb.Sheets                      
        If Left(ws.Name, Len(startName)) = startName Then
            counter = counter + 1
        End If            
    Next ws
    
    Set ws = wb.Sheets.Add
    startName = startName & counter
    ws.Name = startName
End Sub

Upvotes: 1

VBasic2008
VBasic2008

Reputation: 54807

Add Incremented Worksheet

Option Explicit

Sub createIncrementedWorksheet()
    
    Const wsPattern As String = "Area Map "
    
    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
        ' If you just want the number to be one greater then the greatest,
        ' you can use the one liner...
        'n = Application.Max(arr) + 1
        ' ... instead of the following before 'End If':
        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
            
    Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    sh.Name = wsPattern & CStr(n)

End Sub

Upvotes: 1

Related Questions