Unable to delete sheets that meet a condition

user_17915330 0
Viewed 32

I keep getting

runtime error 1004 - Application defined or object defined error

for the code below. Could you help me figure out why this is happening?

Option Explicit

Sub DeleteSheet()

Dim Sh As Worksheet

Application.DisplayAlerts = False

For Each Sh In ThisWorkbook.Worksheets
    If Application.WorksheetFunction.Search("Generation", Sh.Range("A1").Value, 1) = 1 Then
       Sh.Delete
    End If
Next Sh

Application.DisplayAlerts = True

End Sub
vba excel
2 Answers

You can't delete a sheet which is also a control variable in a loop. Use a counter instead to iterate through the sheets, then delete using the counter, eg

dim sheetCount
dim i
sheetCount = ThisWorkbook.Worksheets.Count
for i = sheetCount to 1 step -1
    dim sh as Worksheet
    set sh = ThisWorkbook.Worksheets(i)
    If Application.WorksheetFunction.Search("Generation", sh.Range("A1").Value, 1) = 1 Then
       ThisWorkbook.Worksheets(i).Delete
    End If
next i
user_31799570

Delete Worksheets Using an Array of Worksheet Names

  • I couldn't reproduce the exact error.
  • The covered scenarios producing errors were the following:
    • when generation was not found in cell A1,
    • the last sheet cannot be deleted,
    • when a sheet was very hidden.
  • VBA has its own FIND or SEARCH equivalent called Instr.
  • In the workbook containing this code (ThisWorkbook), it will delete all worksheets whose cell A1 contains a string starting with Generation.
Option Explicit

Sub DeleteSheets()
    
    Dim wsCount As Long: wsCount = ThisWorkbook.Worksheets.Count
    Dim wsNames() As String: ReDim wsNames(1 To wsCount) ' Worksheet Names Array
    
    Dim ws As Worksheet
    Dim n As Long
    
    For Each ws In ThisWorkbook.Worksheets
        ' Check if 'A1' contains a string starting with 'Generation'.
        If InStr(1, CStr(ws.Range("A1").Value), "Generation", _
                vbTextCompare) = 1 Then
            n = n + 1 ' next array element
            wsNames(n) = ws.Name ' write the worksheet name to the array
        End If
    Next ws
    
    ' Check if no worksheet name was added to the array.
    If n = 0 Then Exit Sub
    ' Resize the array to the number of found worksheets.
    If n < wsCount Then ReDim Preserve wsNames(1 To n)
    
    ' Delete the worksheets, without confirmation, in one go.
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(wsNames).Delete
    Application.DisplayAlerts = True

End Sub
user_98140690
Related