Note: My macro not have a error check for if all sheets have only a header in X1
You can't delete all sheets
--
Regards Ron de Bruin
http://www.rondebruin.nl



"Ron de Bruin" wrote in message ...
Use the Counta function on column X

Sub test()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If Application.WorksheetFunction.CountA(sh.Range("X:X ")) = 1 Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = False
End If
Next sh
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl



"VexedFist" wrote in message ups.com...
Help I have been trying to automate the Deletion of sheets with NO
data. All of my worksheets have Column Headers in Row-1. What I need
to do is scroll through the worksheets (about 15-20) and Delete the
sheet if there is no data in Column-X (starting in Row-2). I had the
following but for some reasoon it is not working. I think I am having
a brain-freeze. Any help would be appreciated.

Sub MainMacro()
'
Dim MyString, MyString2 As String
Dim MyWorksheet As String

Range("A1").Select
MyString = "EXTVCML"
MyWorksheet = "Extvcml"
BlankTestMacro MyString, MyWorksheet
MyString = "FAX"
MyWorksheet = "FAX"
BlankTestMacro MyString, MyWorksheet
End Sub
Sub BlankTestMacro(MyString, MyWorksheet)
'
Const SAVESTR As String = "MyString"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Sheets(MyWorksheet).Select
ActiveWindow.WindowState = xlMaximized
Columns("A:BZ").Select
Selection.Sort Key1:=Range("X2"), Order1:=xlDescending,
Key2:=Range("Z2") _
, Order2:=xlAscending, Key3:=Range("A2"), Order3:=xlAscending,
Header:= _
xlYes, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Columns("X:X").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
If Err.Number < 91 And Err.Number < 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
Range("X2").Select
If ActiveCell.Cells = isblank Then
'If Column x IS Blank
ActiveWindow.SelectedSheets.Delete
Exit Sub
End If
If ActiveCell.Row < 0 Then
If Not delRange Is Nothing Then Columns("B:B").Delete
Else
'If Column x is NOT Blank
End If
End Sub