Home > Net >  VBA code to delete sheets with partial name is not working
VBA code to delete sheets with partial name is not working

Time:10-25

I am trying to create code that will delete all sheets in active workbook if name contains part text from input. So far nothing seems working and I have no clue why.

I am using this code:

Private Sub CommandButton28_Click()

   Dim shName As String
   Dim xName As String
   Dim xWs As Worksheet
   Dim cnt As Integer
   shName = Application.InputBox("Enter the specific text:", "Delete sheets", _
                                   ThisWorkbook.ActiveSheet.Name, , , , , 2)
   If shName = "" Then Exit Sub
   xName = "*" & shName & "*"
'    MsgBox xName
   Application.DisplayAlerts = False
   cnt = 0
   For Each xWs In ThisWorkbook.Sheets
       If xWs.Name Like xName Then
           xWs.Delete
           cnt = cnt   1
       End If
   Next xWs
   Application.DisplayAlerts = True
   MsgBox "Have deleted " & cnt & " worksheets", vbInformation, "Sheets removed"


End Sub

But when I enter specific text (no spaces before or after) it doesn't work. Any ideas how to fix it? Here is data from sheet where I tested it: Sheets names

And here is the result of macro: Result of macro

CodePudding user response:

The problem with like is it is expecting one char when using *Name*.

You can use InStr to find your string:

   If InStr(1, xWs.Name, shName ) > 0 Then
       xWs.Delete
       cnt = cnt   1
   End If

CodePudding user response:

You must use InStr instead of 'like' and loop from last sheet to first sheet

   For i = ThisWorkbook.Sheets.Count To 1 Step -1
        Set xWs = ThisWorkbook.Sheets(i)
        If InStr(xWs.Name, shName ) > 0 Then
           xWs.Delete  
           cnt = cnt   1    
       End If
    Next i

CodePudding user response:

Like is case sensitive. Try making the following changes to your code (please see comments starting with '****)

Private Sub CommandButton28_Click()

   Dim shName As String
   Dim xName As String
   Dim xWs As Worksheet
   Dim cnt As Integer
   shName = Application.InputBox("Enter the specific text:", "Delete sheets", _
                                   ThisWorkbook.ActiveSheet.Name, , , , , 2)
   If shName = "" Then Exit Sub
   '**** use LCase() here
   xName = "*" & LCase(shName) & "*"
'    MsgBox xName
   Application.DisplayAlerts = False
   cnt = 0
   For Each xWs In ThisWorkbook.Sheets
       '**** Use LCase() here
       If LCase(xWs.Name) Like xName Then
           xWs.Delete
           'MsgBox xName
           cnt = cnt   1
       End If
   Next xWs
   Application.DisplayAlerts = True
   MsgBox "Have deleted " & cnt & " worksheets", vbInformation, "Sheets removed"


End Sub

Please also note that your code doesn't check if the sheet to be deleted is the only sheet in the workbook (will raise an error). Furthermore, if the user sends * (intentionally or by mistake) your code will delete all sheets except one. This is dangerous, so please think about your code strategy and act accordingly. An idea is to save a backup copy before deleting the sheets

Sub BackupWorkbook(wb As Workbook)
  wb.SaveCopyAs "FULL_BACKUP_PATH" & Format(Now, "yyyymmddhhmmss") & ThisWorkbook.Name
End Sub
  • Related