VBA code to delete multiple sheets at once!!!

Most of the time we face a situation where we need to delete multiple sheets for a workbook. it become a monotonous job when there are large number of sheets which should be deleted. Sometime, because of repetitive task user accidentally deletes useful worksheets. As a result, it consumes lot of productive time which is not a worth in reporting project.

This issue can be overcome using VBA macro which will be used to delete selected worksheet from activeworkbook.Which will result into save productive time and ensure data quality.

Here is the code which will be used to delete selected sheets from active workbook:

Option Explicit

Sub Delete_Selected_Sheets()
' Author: Dreams24
' Written for VBA Tricks and tips blog
' http://vbatricksntips.blogspot.com
'

'Declare Variables used in macro code
Dim shtArray() As String
Dim shtDelArray() As String
Dim shtList As String
Dim i As Integer
Dim NumOfSelectedSheet As Long
Dim Sheets_to_Delete As String
Dim shtSelected, shtDelete As String
Dim sChar, eChar As Integer

On Error GoTo Err:

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Loop to retrieve list of worksheets in active workbook
shtList = ""
For i = 1 To ActiveWorkbook.Sheets.Count
    shtList = shtList & Chr(34) & ActiveWorkbook.Sheets(i).Name & Chr(34) & ","
Next i

'Ask user to enlist worksheet for deletion
shtList = Left(shtList, Len(shtList) - 1)

Sheets_to_Delete = InputBox(prompt:="Adjust the list of sheets which you want to delete ?" & vbNewLine & vbNewLine & "For Example: " & vbNewLine & Chr(34) & "Test_Sheet1" & Chr(34) & "," & Chr(34) & "Test_Sheet2" & Chr(34) & "," & Chr(34) & "Test_Sheet3" & Chr(34), Title:="Delet Worksheets", Default:=shtList)
NumOfSelectedSheet = Len(Sheets_to_Delete) - Len(Replace(Sheets_to_Delete, ",", "")) + 1
sChar = 1

'Loop to delete selected worksheet in inputbox
For i = 1 To NumOfSelectedSheet
    
    If i < NumOfSelectedSheet Then
    eChar = Find_N(",", Sheets_to_Delete, i)
    Else
    eChar = Len(Sheets_to_Delete) + 1
    End If
    
    shtSelected = Mid(Sheets_to_Delete, sChar, eChar - sChar)
    shtDelete = Right(Left(shtSelected, Len(shtSelected) - 1), Len(Left(shtSelected, Len(shtSelected) - 1)) - 1)
    ActiveWorkbook.Sheets(shtDelete).Delete
    sChar = eChar + 1
Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "Selected worksheets deleted successfully !!!", vbInformation

'Error handling code for runtime errors
Err:
    If Err.Number > 0 Then
    
    MsgBox "An error has occured. See below error desciption for details." & vbNewLine & vbNewLine & "VBA Error No: " & Err.Number & vbNewLine & "VBA Error Description: " & Err.Description
    End If
    
End Sub

Function Find_N(tFind_What As String, tInput_String As String, N As Integer) As Integer
' Author: Dreams24
' Written for VBA Tricks and tips blog
' http://vbatricksntips.blogspot.com
'
Dim i As Integer
Application.Volatile

Find_N = 0

For i = 1 To N
Find_N = InStr(Find_N + 1, tInput_String, tFind_What)
If Find_N = 0 Then Exit For
Next i

End Function

If you do not want to write this code again and again, you can use Delete Worksheet Add-ins.
To get your own Add-ins just navigate to "Downloads" screen in VBA Tricks and Tips application's Main window.