Edit my code to delete sheets

[levanoj]

Hello All,

The code below basically allows me to select a Directory, and then deletes all sheets of each file within that Directory that has ROWS 11, 13, 23 & 25 completely blank with no data in any of those cells.

What I'm looking to do is basically have this code do the same but instead delete all sheets with COLUMNS C, D, I & J that are completely blank. Can anyone help?

Sub TemplateTabRem3()
Dim i#, rng As Range, myFolder As String, fn As String, wf As WorksheetFunction
Set wf = Application.WorksheetFunction
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = True Then
        myFolder = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With
fn = Dir(myFolder & "\*.xls")
'On Error Resume Next
Application.DisplayAlerts = False
Do While fn <> ""
    With Workbooks.Open(myFolder & "\" & fn)
        For i = .Worksheets.Count To 1 Step -1
            Set rng = Intersect(.Worksheets(i).[11:11,13:13,23:23,25:25], _
            .Worksheets(i).UsedRange)
                With rng
                   .Replace What:=Chr(32), replacement:="", LookAt:=xlPart
                   .Replace What:=Chr(160), replacement:="", LookAt:=xlPart
                End With
                If wf.CountBlank(rng.Areas(1)) + wf.CountBlank(rng.Areas(2)) + _
                       wf.CountBlank(rng.Areas(3)) + wf.CountBlank(rng.Areas(4)) _
                       = rng.Cells.Count Then .Worksheets(i).Delete
        Next
        .Close True
    End With
    fn = Dir
Loop
Application.DisplayAlerts = True
Set wf = Nothing
End Sub

 

[levanoj]

If it's of any help, I changed the code slightly as shown below:

Sub TemplateTabRem3()
Dim i#, rng As Range, myFolder As String, fn As String, wf As WorksheetFunction
Set wf = Application.WorksheetFunction
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = True Then
        myFolder = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With
fn = Dir(myFolder & "\*.xls")
'On Error Resume Next
Application.DisplayAlerts = False
Do While fn <> ""
    With Workbooks.Open(myFolder & "\" & fn)
        For i = .Worksheets.Count To 1 Step -1
            Set rng = Intersect(.Worksheets(i).[C:C,D:D,I:I,J:J], _
            .Worksheets(i).UsedRange)
                With rng
                   .Replace What:=Chr(32), replacement:="", LookAt:=xlPart
                   .Replace What:=Chr(160), replacement:="", LookAt:=xlPart
                End With
                If wf.CountBlank(rng.Areas(1)) + wf.CountBlank(rng.Areas(2)) + _
                       wf.CountBlank(rng.Areas(3)) + wf.CountBlank(rng.Areas(4)) _
                       = rng.Cells.Count Then .Worksheets(i).Delete
        Next
        .Close True
    End With
    fn = Dir
Loop
Application.DisplayAlerts = True
Set wf = Nothing
End Sub

but got an error of "Run-time error '1004': Application-defined or object-defined error". When I clicked on Debug, I had the following highlighted:

If wf.CountBlank(rng.Areas(1)) + wf.CountBlank(rng.Areas(2)) + _
                       wf.CountBlank(rng.Areas(3)) + wf.CountBlank(rng.Areas(4)) _
                       = rng.Cells.Count Then

Any thoughts?