|
Deleting Sheet with No Data
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 |
Deleting Sheet with No Data
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 |
Deleting Sheet with No Data
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 |
Deleting Sheet with No Data
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 |
Deleting Sheet with No Data
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 |
Deleting Sheet with No Data
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 |
Deleting Sheet with No Data
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 |
Deleting Sheet with No Data
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 |
| All times are GMT +1. The time now is 05:56 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com