I have a workbook that uses a macro and makes many sheets. After one sheet, called Paste, I want to be able to delete the sheets that follow once I am done using them.
I found the following code from https://stackoverflow.com/a/53544169/11615632 and slightly modified it to use in my workbook.
Sub Deleting()
Dim Indx As Long
Dim x As Long
With ThisWorkbook
On Error Resume Next
Indx = .Sheets("Paste").Index
On Error GoTo 0
If Indx <> 1 Then
If .Sheets.Count > 2 And Indx < .Sheets.Count Then
Application.DisplayAlerts = False
For x = .Sheets.Count To Indx + 1 Step -1
.Sheets(x).Delete
On Error GoTo 0
Next x
Application.DisplayAlerts = False
End If
Elseif Indx = 1 Then
Exit Sub
End If
End With
End Sub
However, when I do this it actually works, but I get an error message saying
"Run-time error '-2147319765':
Automation Error
Element not found.
The error is found on the line .Sheets(x).Delete
Since you know that you want to keep two specific sheets ("Value" and "Paste"), instead of using the indexes, which can be a little tricky and may not always work depending on the order/added order of them, I suggest instead looking at the name of each worksheet and delete that way (as mentioned in the comments).
Dim ws as Worksheet
' This next line will suppress the "Confirm Deleting" messagebox
' when you go to delete a worksheet
Application.DisplayAlerts = False
For each ws in ThisWorkbook.Worksheets
If ws.Name <> "Value" and ws.Name <> "Paste" Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
(This assumes the macro is stored in the workbook you want to delete the sheets from. If it's not, perhaps it's stored in Personal.xlsb, then switch ThisWorkbook to ActiveWorkbook or something more specific.)
Related
I'm trying to write code to have several Sheets in a file printed in one print job.
The Sheets to be printed are created dynamically; their names and the number of sheets differ each time, but I know that I want to print all sheets in the workbook apart from Keep1 and Keep2 (In real 7 different sheet names).
The reason I want to print all sheets in one job is that it could be many sheets, and this would mean a long wait and lots of print job pop-ups.
To realize the above, I thought of creating a selection of the sheets I want to print and then order to print.
I wrote the following:
Sub printtest()
Dim arr As Variant, sht As Worksheet
arr = Array("Keep1", "Keep2")
Application.DisplayAlerts = False
For Each sht In ThisWorkbook.Worksheets
If Not UBound(Filter(arr, sht.Name, True, vbtruecompare)) >= 0 Then
With sht.PageSetup
.Zoom = False
.FitToPagesWide = 1
End With
sht.Select False
End If
Next sht
SelectedSheets.PrintOut
Application.DisplayAlerts = True
End Sub
After running the code, I run into the following:
sht.Select False adds up each Sheet meeting the conditions to the current selection, but since the button is on active sheet Keep1 this sheet is part of the selection (and should not be):
The .FitToPagesWide = 1 is performed for each Sheet in the selection, but .FitToPagesTall is also set to 1 (I want to keep this as Automatic, but don't know how to.
I don't know how to reference the selection in my print job properly.
I tried:
sht.PrintOut which results in Run-time error 91 (Object variable or With block variable not set).
SelectedSheets.PrintOut which results ion Run-time error 424 (Object required).
My vba knowledge is limited and I can't find a way to reference the selected pages for the printout.
Thanks for looking into this and explaining what is wrong in this approach.
Print Multiple Worksheets
You rarely need to select anything which is shown in the following code.
It writes the worksheet names to the keys of a dictionary, which are actually an array, and uses this array (the keys) to reference the worksheets to be printed.
Sub PrintTest()
Dim Exceptions() As Variant: Exceptions = Array("Keep1", "Keep2")
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, Exceptions, 0)) Then
With ws.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
End With
dict.Add ws.Name, Empty
End If
Next ws
ThisWorkbook.Worksheets(dict.Keys).PrintOut
Application.DisplayAlerts = True
End Sub
You could try to make a string with only the worksheet names you want, excluding Keep1 and Keep2. Then take that string into an unidimensional array and use that array as your selection of worksheets:
Dim wk As Worksheet
Dim StringWk As String
Dim ArrayWk As Variant
'string of wk names
For Each wk In ThisWorkbook.Worksheets
If wk.Name <> "Keep1" And wk.Name <> "Keep2" Then StringWk = StringWk & wk.Name & "|"
Next wk
StringWk = Left(StringWk, Len(StringWk) - 1) 'clean last | delimiter in string
ArrayWk = Split(StringWk, "|")
Sheets(ArrayWk).Select
'code to print to pdf or whatever
'
'
'
'
'
Sheets("Keep1").Select 'deactivate selection
Erase ArrayWk
To create the array we use SPLIT:
Split
function
hi can you help figure out how to copy worksheet if it existing, and if it is not will automatically create a new workbook then save as blank. please see my code below I try it in if the file is existing copy the file and if not create a new blank file.
Workbooks.Open path1
Sheets.Select
If Sheets("Draft") = "" Then
Set wb = Workbooks.Add
ActiveWorkbook.SaveAs saveFolder & "\D201\D201.xlsx", FileFormat:=51
ActiveWorkbook.Close
Else
Sheets("Draft").Copy
ActiveWorkbook.SaveAs saveFolder & "\D201\D201.xlsx", FileFormat:=51
Workbooks(file1).Close
ActiveWorkbook.Close
End If
and I've encountered an error it says Subscript out of range
Pretty sure you didn't try real hard there (given debugging the error thrown would have lead you to the obvious error). 😊
Here are two possible ways to test for the existence of sheet with a specific name:
Sub Temp()
''' Two possible ways to determine if a sheet with a specific name exists
''' Both assume you're looking for the sheet in the Active Book
''' There are other ways
''' Sledge hammer approach (very efficient)
Dim lgErr&
On Error Resume Next: Err.Clear
With Sheets("Draft"): End With: lgErr = Err
On Error GoTo 0
If lgErr <> 0 Then
' Sheets("Draft") does not exist in the active workbook
Else
' Sheets("Draft") does exist in the active workbook
End If
''' More subtle approach (just as effective and only marginally less efficient)
Dim in1%
For in1 = 1 To Sheets.Count
If Sheets(in1).Name = "Draft" Then Exit For
Next in1
If in1 > Sheets.Count Then
' Sheets("Draft") does not exist in the active workbook
Else
' Sheets("Draft") does exist in the active workbook
End If
End Sub
Notes:
The 1st approach if often used by people confident of their vba skills.
The risk is that a coding error between On Error Resume Next and On Error GoTo 0 could result in and invalid conclusion.
The 2nd approach does not have this same risk.
i usually use a function to test if a sheet exists in my workbook:
Function Feuille_Existe(ByVal Nom_Feuille As String) As Boolean
Dim Feuille As Excel.Worksheet
On Error GoTo Feuille_Absente_Error
Set Feuille = ActiveWorkbook.Worksheets(Nom_Feuille)
On Error GoTo 0
Feuille_Existe = True
Exit Function
Feuille_Absente_Error:
Feuille_Existe = False
End Function
Put this on top of your module and when you need it in your code :
If Feuille_Existe("XXX") Then
'do what you want'
End If
I am trying to create a macro that deletes the active sheet without displaying the prompt. Which is what the code below does...This works great until the last sheet. I get the prompt no matter what. I do not want to delete the last sheet and at the same time, I don't want the error '1004' message to come up. Is there a way to change the code above to not delete my last sheet and not display the error message at the same time?
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
If the idea is to delete the ActiveSheet and only it, this is something that will work, until there is only 1 sheet in the workbook:
Sub DeleteActiveSheet()
If ThisWorkbook.Worksheets.Count = 1 Then
Exit Sub
Else
Application.DisplayAlerts = False
ThisWorkbook.ActiveSheet.Delete
Application.DisplayAlerts = True
End If
End Sub
If the idea is to delete all worksheets, but the last, then follow this sequence:
assign a worksheet variable wksToStay from the type Worksheet and set it to the last worksheet in the workbook;
loop through all the Worksheets in the Workbook.Worksheets collection, starting from the last one;
always perform a check, whether the worksheet to be deleted wksToDelete has the same name as the wksToStay;
delete, if the name is not the same;
it will delete all the worksheets, including the hidden and the very hidden ones;
Sub DeleteAllButLast()
Dim wksToStay As Worksheet
Dim wksToDelete As Worksheet
Dim i As Long
Set wksToStay = ThisWorkbook.Worksheets(Worksheets.Count)
For i = Worksheets.Count To 1 Step -1
Set wksToDelete = ThisWorkbook.Worksheets(i)
If wksToDelete.Name <> wksToStay.Name Then
Application.DisplayAlerts = False
wksToDelete.Delete
Application.DisplayAlerts = True
End If
Next
End Sub
Test the next code, please:
Sub deleteExceptTheLastSh()
If ActiveWorkbook.Sheets.count > 1 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Else
MsgBox "This is the last sheet and it cannot be deleted!"
End If
End Sub
This happens because you cannot delete the last worksheet in a workbook. Is the macro you have executed with a button? If you do not like the 1004 message, one possible solution may be to create a custom error message:
Sub deleteActiveSheet()
Application.DisplayAlerts = False
On Error GoTo Error
ActiveSheet.Delete
Application.DisplayAlerts = True
Exit Sub
Error:
MsgBox "you cannot delete the last worksheet in the workbook!"
End Sub
If I understand correctly, you don't want to delete the last worksheet, and you want to avoid the error message.
You could try this:
Sub deleteallbutlast()
Application.DisplayAlerts = False
If Worksheets.Count > 1 Then
ActiveSheet.Delete
Else
End
End If
Application.DisplayAlerts = True
End Sub
When the code below reaches the .Delete instruction it goes into an endless loop. When stopped in the Task Manager an error message "Automation error" is displayed. When the Debug button in the error message is pressed the .Delete line is highlighted. The sheet isn't deleted. The alert message isn't displayed.
Sub DeleteXlTable(Wb As Workbook, _
Frm As fTextLib)
' SSY 047 ++ 30 Dec 2018
Dim LibWs As Worksheet
Dim Rng As Excel.Range
' Application.DisplayAlerts = False
Set LibWs = SetLibWs(Wb, Frm)
With LibWs
If .ListObjects.Count = 1 Then
If Wb.Worksheets.Count = 1 Then
With .UsedRange
.Columns.Delete
.Rows.RowHeight = 12.75
End With
.Name = "Sheet1"
Else
.Delete
End If
Else
Set Rng = .ListObjects(Frm.CbxTbl.Text).Range
Do While Rng.Row > NwsFirstLibRow
If Not .Cells(Rng.Row - 1, NwsKey).ListObject Is Nothing Then Exit Do
Set Rng = Rng.Offset(-1).Resize(Rng.Rows.Count + 1)
Loop
Rng.Rows.EntireRow.Delete
End If
End With
Application.DisplayAlerts = True
End Sub
The code is called in a VBA project embedded in MS Word. The Excel application is called properly and available. The Worksheet exists and is accessible at the time of the error. I tried replacing the line with the full object's name, Wb.Worksheets(LibWs.Name).Delete, with the same result. I tried deleting the ListObject before deleting the sheet. The table was deleted but the same error occurred on the next line.
Similar code run from a stand-alone Excel application works perfectly, even if the deleted sheet is the active one. I wonder whether I should save the workbook before deleting the sheet but don't know why that should make a difference. Any ideas what I might do?
Per our earlier conversation, it seems as if the alert in Excel in causing an issue.
Add:
Wb.Parent.DisplayAlerts = False
Where:
Application.DisplayAlerts = False
was commented out.
I am trying to run a macro that will remove any rows that have a #REF! as well as remove the header. On top of all of that, I would also like for the macro to go through and apply this option for all worksheets except the first one.
When I try to run it acts as if it worked, but when I checked the specific worksheets where this applies nothing has happened.
Sub RemoveGamesOut()
Dim i As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> "1962-63 Stats" Then ws.Range ("C6:C5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For i = Range("C" & Rows.Count).End(3).Row To 5 Step -1
If IsError(Cells(i + 1, "C")) = True Then Rows(i).Resize(2).Delete
Next i
Next ws
End Sub