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.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.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.