In Excel, I need to delete all sheets which don't end in (2)
The following code corrently deletes those which DO end in (2), I'm just not sure how to reverse this, 'Not Like' doesn't seem to work
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If ws.Name Like "*" & "(2)" Then
'~~> This check is required to ensure that you don't get an error
'~~> if there is only one sheet left and it matches the delete criteria
If ThisWorkbook.Sheets.Count = 1 Then
MsgBox "There is only one sheet left and you cannot delete it"
Else
'~~> This is required to supress the dialog box which excel shows
Application.DisplayAlerts = False
ws.delete
Application.DisplayAlerts = True
End If
End If
Next
Not works fine here, you just have to negate the full expression
If Not ws.Name Like "*" & "(2)" Then
Just a slight tip over your current code. Move the Application.DisplayAlerts outside of your loop. These only need to be turned off and on once in the entire macro, where as you're turning it off an on for each sheet. This increases the number of iterations in your code and bloats your macro.
Also for your original question your if statement runs if the (2) is present in the sheet name. To change this simply put Not after the if.
You can also do this using just one If statement slimming down your code once again.
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
If Not ws.Name Like "*" & "(2)" and ThisWorkbook.Sheets.Count > 1 Then
ws.delete
ElseIf ThisWorkbook.sheets.count = 1 then
MsgBox "There is only one sheet left and you cannot delete it"
Exit Sub
End If
Next ws
Application.DisplayAlerts = True
Related
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
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
How can I delete sheet where the sheet name like
Left(SheetExists.Name, 16) = "Mgt Report as at"
Tried:
Sheets(Left(SheetExists.Name, 16) = "Mgt Report as at").Delete
Something like this (not tested):
For Each s in ActiveWorkbook.Sheets
If Left(s.Name, 16) = "Mgt Report as at" Then
s.Delete
End If
Next s
Another way using LIKE as you have mentioned in the title of your question.
Also note, in such a scenario, you have to be careful when you are deleting the sheets. See the comments in the code below.
Option Explicit
Sub Sample()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If ws.Name Like "Mgt Report as at" & "*" Then
'~~> This check is required to ensure that you don't get an error
'~~> if there is only one sheet left and it matches the delete criteria
If ThisWorkbook.Sheets.Count = 1 Then
MsgBox "There is only one sheet left and you cannot delete it"
Else
'~~> This is required to supress the dialog box which excel shows
'~~> When you delete a sheet. Remove it if you want to see the
'~~~> Dialog Box
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
End If
Next
End Sub