I know it is because of the "Or" but I was hoping someone could explain why it does not work.
If (Sheet.Name <> "Dep 1" Or "Test") Then
^
Sub DeleteSheet()
Dim Sheet As Worksheet
Application.DisplayAlerts = False
For Each Sheet In ActiveWorkbook.Sheets
If (Sheet.Name <> "Dep 1" Or "Test") Then
Sheet.Delete
End If
Next Sheet
Application.DisplayAlerts = False
End Sub
My "Two-cents" to this post:
Try to use meaningful variable names, but NOT ones that are too close to Excel's saves words. Dim Sheet is ~ 85% similar to Sheets, which is a type of Object, I've seen so many posts here that people get cell with Cells mixed-up and get a run-time error.
I've switched your If with Select Case .Name, this way, if in the future you have add more Worksheets or want to perform other actions on other Worksheets, it will be easier to modify the code.
Code
Option Explicit
Sub DeleteSheet()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Sheets
With ws
Select Case .Name
Case "Dep 1", "Test"
' do nothing for now
Case Else
.Delete
End Select
End With
Next ws
Application.DisplayAlerts = True ' <-- restore setting
End Sub
Related
I have a macro that generates a lot of worksheets and charts. There's also various subroutines that run so the names and quantity of each worksheet/chart generated is never the same. What is constant is my HOME worksheet which is the UI for the user and I want it to be unaffected.
I found a similar question here about deleting all worksheets except the one you are working with (i.e. HOME). Here's what I have so far.
Sub ZRESET()
Dim ws As Worksheet, wb As Workbook
Set wb = ActiveWorkbook
Sheets("HOME").Select
Application.DisplayAlerts = False
For Each ws In wb.Worksheets
If ws.Name <> "HOME" Then
ws.Delete
End If
If Chart.Name = "" Then
Charts.Delete
End If
Next
Application.DisplayAlerts = True
Range("B5:E5,B9:E9,B13:E13,B14:E14").ClearContents
Range("A1").Select
End Sub
The worksheets delete fine, the hang up I have is the charts. I tried various attempts to remove charts and sometimes they work (i.e placing Charts.Delete outside of a FOR loop and IF statement). But this requires me to actually have a chart in the workbook. Sometime the user can just develop worksheets but no charts.
Any advice to continue my goal of deleting SHEETS and/or CHARTS, while keeping my HOME sheet intact?
Option Explicit
Sub GetRid()
Dim ASheet As Worksheet
Dim AChart As Chart
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'** first scan for and delete all non HOME worksheets ***
For Each ASheet In ActiveWorkbook.Worksheets
If UCase(ASheet.Name) <> "HOME" Then
ASheet.Delete
End If
Next
'** Now scan and delete any ChartSheets ****
For Each AChart In ActiveWorkbook.Charts
AChart.Delete
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub AllSheetsAndcharts()
Dim AChart As ChartObject
Dim ASheet As Worksheet
Application.DisplayAlerts = False
For Each ASheet In ActiveWorkbook.Worksheets
If UCase(ASheet.Name) <> "HOME" Then
For Each AChart In ASheet.ChartObjects
AChart.Delete
Next
ASheet.Delete
End If
Next
Application.DisplayAlerts = False
End Sub
I'm not that "code smart" so I'm terribly sorry for hurting your experienced eyes when gazing upon the mess below :)
The goal: create a simple filter in a master sheet that shows only the sheets that meet a specific value in a cell.
The master sheet is called "MEGAFILTER", the other sheets are called "1", "2", "3", etc. (no quotes)
How I made it work so far (again, sorry!):
Sub MEGAFILTER()
'
' MEGAFILTER Macro
'
'
Sheets("MEGAFILTER").Select
Range("A1").Select
Dim Filter As String
Filter = ActiveCell.Value
'This makes sure all sheets are visible (for subsequent filtering)
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
'This is where the real mess kicks in
Sheets("1").Select
If [M2] = Filter Then
Sheets("1").Visible = True
Else
Sheets("1").Visible = False
End If
Sheets("2").Select
If [M2] = Filter Then
Sheets("2").Visible = True
Else
Sheets("2").Visible = False
End If
Sheets("MEGAFILTER").Select
Sheets("3").Select
If [M2] = Filter Then
Sheets("3").Visible = True
Else
Sheets("3").Visible = False
End If
Sheets("MEGAFILTER").Select
'ETC...
End Sub
100 sheets are covered like this. If there are 70 sheets present, it will of course crash when attempting to select 71. The "MEGAFILTER" select makes sure it always lands on the master sheet before it crashes. I realize this is terrible but I didn't succeed to make a proper way :(
Here's how I thought it should be:
Sub MEGAFILTER()
'
' MEGAFILTER Macro
'
'
Sheets("MEGAFILTER").Select
Range("A1").Select
Dim Filter As String
Dim ws As Worksheet
Filter = ActiveCell.Value
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "MEGAFILTER" Then
If [M2] = Filter Then
ws.Visible = True
Else
ws.Visible = False
End If
Next ws
End If
End Sub
But I'm getting a "Next without For" error on that. The intention is that it skips the master sheet (it shouldn't hide that one) and compares the value in cell M2 to the value in cell A1 on the master sheet. If the value is the same, it should show the sheet, if not, it should hide the sheet. Then it should move to the next sheet until all have been checked.
Believe it or not, I spent a few hours with all sorts of combinations on this before I posted this question. I feel like an idiot...
I hope someone can correct my "creativity". Thank you for reading!
Timmy
This should work:
Public Sub MegaFilter()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Mega Filter" Then
ws.Visible = ws.Cells(2, 13) = ThisWorkbook.Worksheets("Mega Filter").Cells(1, 1)
End If
Next ws
End Sub
It checks if cell M2 (Cells(2,13)) on each sheet equals cell A1 on Mega Filter.
In Excel VBA TRUE = -1 and FALSE = 0. The numerical value for xlSheetHidden is 0, xlSheetVisible is -1.
So, if M2=A1 TRUE is returned (-1) and the sheet is made visible, otherwise FALSE is returned (0) and the sheet is hidden.
Sub HideSheet()
Dim sheet As Worksheet
Set sheet = ActiveSheet
' this hides the sheet but users will be able
' to unhide it using the Excel UI
sheet.Visible = xlSheetHidden
' this hides the sheet so that it can only be made visible using VBA
sheet.Visible = xlSheetVeryHidden
End Sub
I am a new user of vba.
There is recently a vba problem that has left me rather clueless and helpless - subscript out of range - on a particular user's computer when every other user seems to have no issue with using the macro (myself included) hence I can't simply trial and error to troubleshoot.
Hence really need expert help from all of you! Really really appreciated!!
I have used a series of vba, which will run one after another and have pasted them in chronological order as follows.
VBA 1
Sub VBA_1()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Outline.ShowLevels 1, 1
Next ws
End Sub
VBA 2
Sub VBA_2()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Protect ("Password")
Next ws
End Sub
VBA 3
Sub VBA_3()
Dim iRet As Integer
Dim strPrompt As String
'Prompt
strPrompt = "This will take about 2 minutes. Click 'OK' to proceed."
'Show msgbox
iRet = MsgBox(strPrompt, vbOKCancel)
'When user clicked 'OK'..
If iRet = vbOK Then
'SaveAs Function
Dim fName As String
fName = Application.GetSaveAsFilename(, "Excel Binary Workbook (*.xlsb), *.xlsb")
If fName = "False" Then
MsgBox "File not saved.", vbOKOnly
Cancel = True
End If
Application.EnableEvents = False
ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlExcel12
Application.EnableEvents = True
' Calculate
Application.Calculate
Application.ScreenUpdating = True
' Outlet
Worksheets("Total Outlets").Activate
'Copy and Paste this portion to each worksheet
For Each cell In Range("A1")
If cell.Value = "Not Applicable" Then
ActiveSheet.Visible = xlSheetHidden
Else
Call HypMenuVRefresh
End If
Next
'End Outlet & Copy and Paste
Worksheets("D11101").Activate
For Each cell In Range("A1")
If cell.Value = "Not Applicable" Then
ActiveSheet.Visible = xlSheetHidden
Else
Call HypMenuVRefresh
End If
Next
Worksheets("D11102").Activate
For Each cell In Range("A1")
If cell.Value = "Not Applicable" Then
ActiveSheet.Visible = xlSheetHidden
Else
Call HypMenuVRefresh
End If
Next
'Hide sheets accordingly
Worksheets("Restaurant List").Visible = xlSheetVeryHidden
Worksheets("Hotel List").Visible = xlSheetVeryHidden
'Recalculate
Application.Calculate
Application.ScreenUpdating = True
'Renaming of tabs
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Range("A2").Value = 1 Then
If ws.Visible = xlSheetVisible Then
On Error Resume Next
ws.Name = ws.Range("A10").Value
End If
End If
Next ws
'Save Workbook
ActiveWorkbook.Save
'Enable finishing screen to be 'Input'
Sheets("Input").Select
'Show msgbox
MsgBox ("Retrieval Completed!")
Else
MsgBox ("Retrieval of Data Cancelled")
End If
End Sub
I can think of the following possible causes but do not say any of them is the actual cause:
"...on a particular user's computer..."
Then:
the version of Excel/VBA is different;
somehwere a global Option Base is set (but I believe this cannot be set global, i.e. applicable to all workbooks loaded);
somewhere a separator is "hard coded" that does not conform to the Windows global setings (Control Panel --> Region and Language --> Formats --> Additional Settings);
the language differs with a reflection in VBA (e.g. a keyword/function name in the native language or identifier names with non-US ASCII 7 bit characters).
To find in where the program encounters the error (and stops), make a function that writes a status message to a file after every major step. Make sure to close the file after every message so the message is actually written.
I have a macros that generates a number of workbooks. I would like the macros, at the start of the run, to check if the file contains 2 spreadsheets, and delete them if they exist.
The code I tried was:
If Sheet.Name = "ID Sheet" Then
Application.DisplayAlerts = False
Sheet.Delete
Application.DisplayAlerts = True
End If
If Sheet.Name = "Summary" Then
Application.DisplayAlerts = False
Sheet.Delete
Application.DisplayAlerts = True
End If
This code is returning an error:
run time error #424, object required.
I probably have the wrong formatting, but if there is an easier way to do this, it would be very useful.
Consider:
Sub SheetKiller()
Dim s As Worksheet, t As String
Dim i As Long, K As Long
K = Sheets.Count
For i = K To 1 Step -1
t = Sheets(i).Name
If t = "ID Sheet" Or t = "Summary" Then
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
End If
Next i
End Sub
NOTE:
Because we are deleting, we run the loop backwards.
Try this code:
For Each aSheet In Worksheets
Select Case aSheet.Name
Case "ID Sheet", "Summary"
Application.DisplayAlerts = False
aSheet.Delete
Application.DisplayAlerts = True
End Select
Next aSheet
You could use On Error Resume Next then there is no need to loop through all the sheets in the workbook.
With On Error Resume Next the errors are not propagated, but are suppressed instead. So here when the sheets does't exist or when for any reason can't be deleted, nothing happens. It is like when you would say : delete this sheets, and if it fails I don't care. Excel is supposed to find the sheet, you will not do any searching.
Note: When the workbook would contain only those two sheets, then only the first sheet will be deleted.
Dim book
Dim sht as Worksheet
set book= Workbooks("SomeBook.xlsx")
On Error Resume Next
Application.DisplayAlerts=False
Set sht = book.Worksheets("ID Sheet")
sht.Delete
Set sht = book.Worksheets("Summary")
sht.Delete
Application.DisplayAlerts=True
On Error GoTo 0
Worksheets("Sheet1").Delete
Worksheets("Sheet2").Delete
try this within your if statements:
Application.DisplayAlerts = False
Worksheets(“Sheetname”).Delete
Application.DisplayAlerts = True
I would like to know why VBA is telling me that the SUB function is missing while trying to write this code. The purpose should be that when the sheet is called NVT the code should skip any operation and go to the next sheet that will be activated (in the next command). In the end of this operation I should delete every blanc sheet(s) where there is no "specific name" or "NVT" filled in.
The formula is working good without this option. I have no problem saving this code and no problem with the formula itselve. Any suggestion is welcom.. I don't believe this threat has been posted yet.
Please let me know if you need additional information. The original code is verry long and would like just a indication how to sove this issue.Thanx in advace for who will answer tis threat.
Sub Printtabs()
' Print
ThisWorkbook.Activate
If ThisWorkbook.Sheets(7) = ("NVT") Then Skip
If ThisWorkbook.Sheets(7) = ("NAME SPECIFIC 1") Then
'process formula
End If
If Thisworkbook.Sheets (8) = ("NVT) Then Skip
If Thisworkbook.Sheets (8) = ("NAME SPECIFIC 2") Then
'process formula
End If
'then I should find the way to delete every "blanc" sheets in this workbook (becouse I skipped before and there will be blanc sheets) and save
End Sub
You don't need to use .Activate. You can directly work with the sheets. Also when deleting sheets and switching off events, always use proper error handling.
Is this what you are trying?
Dim ws As Worksheet
Sub Printtabs()
On Error GoTo Whoa
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "NAME SPECIFIC 1" Then
'~~> Process Formula
ElseIf ws.Name = "NAME SPECIFIC 2" Then
'~~> Process Formula
Else
If ws.Name <> "NTV" And WorksheetFunction.CountA(ws.Cells) = 0 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
End If
Next ws
LetsContinue:
Application.DisplayAlerts = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
So, I figured out how to delete the blanc sheets I believe.
Only the issue with sheetsnames is remaining.
This part of code I will run at the end of all processed formulas.
Hopely somebody could help me out....
Dim ws As Worksheet
For Each ws In Worksheets
If WorksheetFunction.CountA(ws.Cells) = 0 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws