How to Create New sheet with suffix and How to Delete them with Prefix

[Bijan2048]

Hi Masters
I need a VBA code to create new sheet with Suffix number,
for example if a sheet named REPORT1 is exist , each time VBA code run, new sheet create another one with name REPORT2 and 3,4,......
in addition I need a VBA code to delete any sheets that name begins with REPORT
Thanks in advanced

 

[HighAndWilder]

Hi Masters
I need a VBA code to create new sheet with Suffix number,
for example if a sheet named REPORT1 is exist , each time VBA code run, new sheet create another one with name REPORT2 and 3,4,......
in addition I need a VBA code to delete any sheets that name begins with REPORT
Thanks in advanced

One procedure to create sheets and one to delete them.

Test on a NEW workbook.

Call with :

Call subCreateNewSheet("Report")

Call subDeleteSheets("Report")

Public Sub subCreateNewSheet(strPrefix As String)
Dim Ws As Worksheet
Dim intMax As Integer

  For Each Ws In ActiveWorkbook.Worksheets
  
    If LCase(Ws.Name) Like LCase(strPrefix) & "*" Then
                      
      If Val(Replace(Ws.Name, strPrefix, "", 1)) > intMax Then
      
        intMax = Val(Replace(Ws.Name, strPrefix, "", 1))
      
      End If
             
    End If
  
  Next Ws
  
  Worksheets.Add after:=Sheets(Sheets.Count)
  
  ActiveSheet.Name = strPrefix & intMax + 1

End Sub

Public Sub subDeleteSheets(strPrefix As String)
Dim Ws As Worksheet
Dim intMax As Integer

  Application.DisplayAlerts = False
  
  For Each Ws In ActiveWorkbook.Worksheets
  
    If LCase(Ws.Name) Like LCase(strPrefix) & "*" Then
                      
      Ws.Delete
                  
    End If
  
  Next Ws
  
  Application.DisplayAlerts = True
  
End Sub

 

[DanteAmor]

Here a couple of macros to consider

To create:

Sub Create_Sheets()
  Dim sh As Worksheet
  Dim sName As String
  Dim nMax As Long, n As Long
  
  Application.ScreenUpdating = False
  sName = "REPORT"
  
  For Each sh In Sheets
    If UCase(Left(sh.Name, Len(sName))) = sName Then
      n = Replace(sh.Name, sName, "") + 1
      If n > nMax Then nMax = n
    End If
  Next
  
  If n = 0 Then nMax = 1
  Sheets.Add(, Sheets(Sheets.Count)).Name = sName & nMax
  
  Application.ScreenUpdating = True
End Sub

To delete:

Sub Delete_Sheets()
  Dim sh As Worksheet
  Dim sName As String
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  sName = "REPORT"
  
  For Each sh In Sheets
    If UCase(Left(sh.Name, Len(sName))) = sName Then
      sh.Delete
    End If
  Next
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

 

[Bijan2048]

Here a couple of macros to consider

To create:

Sub Create_Sheets()
  Dim sh As Worksheet
  Dim sName As String
  Dim nMax As Long, n As Long
 
  Application.ScreenUpdating = False
  sName = "REPORT"
 
  For Each sh In Sheets
    If UCase(Left(sh.Name, Len(sName))) = sName Then
      n = Replace(sh.Name, sName, "") + 1
      If n > nMax Then nMax = n
    End If
  Next
 
  If n = 0 Then nMax = 1
  Sheets.Add(, Sheets(Sheets.Count)).Name = sName & nMax
 
  Application.ScreenUpdating = True
End Sub

To delete:

Sub Delete_Sheets()
  Dim sh As Worksheet
  Dim sName As String
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  sName = "REPORT"
 
  For Each sh In Sheets
    If UCase(Left(sh.Name, Len(sName))) = sName Then
      sh.Delete
    End If
  Next
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Thank you
The codes work Great.

 

[DanteAmor]

Thank you
The codes work Great.

Im glad to help you, thanks for the feedback.