CODEWITHSUNDEEP
vbaexcel
MTBthePRO
MTBthePRO

Reputation: 520

Deleting Worksheets if range is blank

I made a code that would delete Worksheets if range "D14:K70" is empty throughout the workbook but I do not know how to ignore "-----------" which are in the worksheet range 72x and empty spaces are 368x. Also I am having an issue at Sheets(i).Delete

Sub DeletingEmptyPages()

Dim i As Long

For i = Sheets.count To 1 Step -1
    If WorksheetFunction.CountIf(Sheets(i).Range("D14:K70"), "") >= 368 Then
        If Sheets.count > 1 Then
            Application.DisplayAlerts = False
            Sheets(i).Delete
            Application.DisplayAlerts = True
        Else
            MsgBox "Only 1 sheet left"
            Exit Sub
        End If
    End If
Next i
End Sub

Upvotes: 0

Views: 261

Answers (2)

MTBthePRO
MTBthePRO

Reputation: 520

Sub DeletingEmptyPages()

Dim i As Long

For i = Sheets.count To 1 Step -1
    If WorksheetFunction.CountA(Sheets(i).Range("D14:K25, D27:K27, D29:K31, D34:K34, D36:K52, D55:K55, D57:K57, D59:K66, D68:K68, D70:K70 "), "") >= 368 Then
        If Sheets.count > 1 Then
            Application.DisplayAlerts = False
            Sheets(i).Delete
            Application.DisplayAlerts = True
        Else
            MsgBox "Only 1 sheet left"
            Exit Sub
        End If
    End If
Next i
End Sub

Upvotes: 0

Captain Grumpy
Captain Grumpy

Reputation: 520

A slightly different way of approaching the same issue. You could add in a do whole loop to stop if it find something as it will speed up the process slightly but the range is so small I don't think it will be an issue.

Sub DeletingEmptyPages()

Dim i As Long
Dim strTestRange As String
Dim bDeleteSheet As Boolean

strTestRange = "D14:K70"

For Each ws In ThisWorkbook.Worksheets
    bDeleteSheet = True
    For Each c In ws.Range(strTestRange)
        If Not (c.Value = "" Or c.Value = "-") Then bDeleteSheet = False
    Next c

    If bDeleteSheet Then
        If Sheets.Count > 1 Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        Else
            MsgBox "Only 1 sheet left"
            Exit Sub
        End If
    End If

Next ws

End Sub

Upvotes: 0

Related Questions