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

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

Don't get your code, but isn't this all you need?

Sub MainMacro()
Dim MyWorksheet As String

For Each MyWorksheet In ActiveWorkbook.Worksheets
If ActiveSheet.Name < MyWorksheet.Name Then
BlankTestMacro MyWorksheet
Next MyWorksheet
End Sub
Sub BlankTestMacro(sh As Worksheet)

If Application.CountA("X2:X65536") = 0 Then
sh.Delete
End If
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"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

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

BOB,

When I try to run your Macro I get the following error:

Compile Error:

For Each control variable Must be Variant or Object


Any idea's??



Bob Phillips wrote:
Don't get your code, but isn't this all you need?

Sub MainMacro()
Dim MyWorksheet As String

For Each MyWorksheet In ActiveWorkbook.Worksheets
If ActiveSheet.Name < MyWorksheet.Name Then
BlankTestMacro MyWorksheet
Next MyWorksheet
End Sub
Sub BlankTestMacro(sh As Worksheet)

If Application.CountA("X2:X65536") = 0 Then
sh.Delete
End If
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"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

Sorry, didn't change one bit of your code

Sub MainMacro()
Dim MyWorksheet As Worksheet

For Each MyWorksheet In ActiveWorkbook.Worksheets
If ActiveSheet.Name < MyWorksheet.Name Then
BlankTestMacro MyWorksheet
Next MyWorksheet
End Sub
Sub BlankTestMacro(sh As Worksheet)

If Application.CountA("X2:X65536") = 0 Then
sh.Delete
End If
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"VexedFist" wrote in message
oups.com...
BOB,

When I try to run your Macro I get the following error:

Compile Error:

For Each control variable Must be Variant or Object


Any idea's??



Bob Phillips wrote:
Don't get your code, but isn't this all you need?

Sub MainMacro()
Dim MyWorksheet As String

For Each MyWorksheet In ActiveWorkbook.Worksheets
If ActiveSheet.Name < MyWorksheet.Name Then
BlankTestMacro MyWorksheet
Next MyWorksheet
End Sub
Sub BlankTestMacro(sh As Worksheet)

If Application.CountA("X2:X65536") = 0 Then
sh.Delete
End If
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"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

This will work (I make a few changes)

Better use this if you not want to see the warning

Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True


Sub MainMacro()
Dim MyWorksheet As Worksheet

For Each MyWorksheet In ActiveWorkbook.Worksheets
If ActiveSheet.Name < MyWorksheet.Name Then
BlankTestMacro MyWorksheet
End If
Next MyWorksheet
End Sub

Sub BlankTestMacro(sh As Worksheet)
If Application.CountA(sh.Range("X2:X65536")) = 0 Then
sh.Delete
End If
End Sub


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



"Bob Phillips" wrote in message ...
Sorry, didn't change one bit of your code

Sub MainMacro()
Dim MyWorksheet As Worksheet

For Each MyWorksheet In ActiveWorkbook.Worksheets
If ActiveSheet.Name < MyWorksheet.Name Then
BlankTestMacro MyWorksheet
Next MyWorksheet
End Sub
Sub BlankTestMacro(sh As Worksheet)

If Application.CountA("X2:X65536") = 0 Then
sh.Delete
End If
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"VexedFist" wrote in message
oups.com...
BOB,

When I try to run your Macro I get the following error:

Compile Error:

For Each control variable Must be Variant or Object


Any idea's??



Bob Phillips wrote:
Don't get your code, but isn't this all you need?

Sub MainMacro()
Dim MyWorksheet As String

For Each MyWorksheet In ActiveWorkbook.Worksheets
If ActiveSheet.Name < MyWorksheet.Name Then
BlankTestMacro MyWorksheet
Next MyWorksheet
End Sub
Sub BlankTestMacro(sh As Worksheet)

If Application.CountA("X2:X65536") = 0 Then
sh.Delete
End If
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"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

And a Type also in my Macro

Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = False

Must be

Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True

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



"Ron de Bruin" wrote in message ...
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