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
Related
I have some macros that copy my sheet in excel,and delete certain data. Unfortunately the buttons to which the macros are assigned do not copy over when the macros are run.
Sub CandD()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sh As Shape, strtSh As Worksheet
Set strtSh = ActiveSheet
Sheets("BM Condition").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "BM Condition" & Sheets.Count - 1
Range("E14:E33,I14:I33,M14:M33").ClearContents
For Each sh In ActiveSheet.Shapes
sh.Delete
Next sh
strtSh.Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
This is the macro I am using. I have very limited VBA experience and am not finding google very helpful. Could someone recommend a fix for my buttons not copying over?
EDIT: I forgot to mention that when manually copying the buttons remain. I am not sure why this is.
As FunThomas mentioned, I've tried and tested the following without any errors:
Sub CanD()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sh As Shape, strtSh As Worksheet
Set strtSh = ActiveSheet
Sheets("BM Condition").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "BM Condition" & Sheets.Count - 1
Range("E14:E33,I14:I33,M14:M33").ClearContents
strtSh.Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
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 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'm writing a macro in VBA for Excel. I want it to replace all worksheets except for a few. First there is a loop which deletes the unwanted sheets, and then comes another one which creates new sheets to repace them! On a first run, the macro removes unwanted sheets. However, if it is run again it seems to be unable to delete the sheets it previously created, which causes a name duplicity error.
(The rng variable is supposed to extend across the entire row but I haven't gotten to fixing that yet.)
Hope you guys can provide some insight, much appreciated!
sub Terminator()
Dim Current As Worksheet
Application.DisplayAlerts = False
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
If Not Current.Name = "Data" Then
Worksheets(Current.Name).Delete
End If
Next Current
Application.DisplayAlerts = True
' Define range for loop
Dim rng As Range, cell As Range
Set rng = Sheets("Data").Range("A5:M5")
' Loop through entire row, looking for employees
For Each cell In rng
If cell.Value = "Nummer" Then
' Make new chart for employee
With Charts.Add
.ChartType = xlLineMarkers
.Name = cell.Offset(-1, 1).Value
.HasTitle = True
.ChartTitle.Text = cell.Offset(-1, 1).Value
' Set data (dynamic) and x-axis (static) for new chart
.SetSourceData Source:=Sheets("Data").Range(cell.Offset(-2, 3), cell.Offset(7, 4))
.Axes(xlValue).MajorGridlines.Select
.FullSeriesCollection(1).XValues = "=Data!E4:E12"
' Add trendlines
.FullSeriesCollection(1).Trendlines.Add Type:=xlLinear, Forward _
:=0, Backward:=0, DisplayEquation:=0, DisplayRSquared:=0, Name:= _
"Trend (DDE)"
.FullSeriesCollection(2).Trendlines.Add Type:=xlLinear, Forward _
:=0, Backward:=0, DisplayEquation:=0, DisplayRSquared:=0, Name:= _
"Trend (SDE)"
End With
' Chart is moved to end of all sheets
Sheets(cell.Offset(-1, 1).Value).Move _
after:=Sheets(Sheets.Count)
End If
Next cell
End Sub
No need to define the worksheet with the Worksheets()
Sub Terminator()
Dim Current As Worksheet
Application.DisplayAlerts = False
' Loop through all of the worksheets in the active workbook.
For Each Current In ActiveWorkbook.Worksheets
If Not Current.Name = "Data" Then
Current.Delete
End If
Next Current
Application.DisplayAlerts = True
End sub
The Following code (minor changes worked in my workbook), are you sure you have the names you put in the If in your Workbook ?
Anyway, I think it's better to use Select for multiple possible mathces
Sub Terminator()
Dim Current As Excel.Worksheet
Application.DisplayAlerts = False
' Loop through all of the worksheets in the active workbook.
For Each Current In ActiveWorkbook.Sheets
If Not (Current.Name = "Data") Then
ActiveWorkbook.Worksheets(Current.Name).Delete
End If
Next Current
Application.DisplayAlerts = True
End Sub
Solution to the deletion is supplied by RGA, but in case you want to avoid several AND statements for each sheet that you want to retain, you can utilize a function similar to the isInArray below:
Sub Terminator()
Dim Current As Variant
Application.DisplayAlerts = False
' Loop through all of the worksheets in the active workbook.
For Each Current In ThisWorkbook.Sheets
If Not isInArray(Current.Name, Array("Data")) Then
Current.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Function isInArray(theValue As String, vArr As Variant) As Boolean
Dim vVal As Variant
isInArray = False
For Each vVal In vArr
If LCase(vVal) = LCase(theValue) Then
isInArray = True
End If
Next
End Function
EDIT:
function that takes a worksheet name as argument, and returns a worksheet object of that name. If the name is allready taken, the existing sheet is deleted and a new one created:
'example of use:
'set newWorksheet = doExist("This new Sheet")
Function doExist(strSheetName) As Worksheet
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsTest As Worksheet
Dim nWs As Worksheet
Set wsTest = Nothing
On Error Resume Next
'Set wsTest = wb.Worksheets(strSheetName) 'commented out in Edit of Edit
Set wsTest = wb.Sheets(strSheetName) 'as a comment for one of the other threads reveal, the error could be the deletion of Worksheets, which would be a subgroup to Sheets of which graph sheets are no a part
On Error GoTo 0
If Not wsTest Is Nothing Then
Application.DisplayAlerts = False
wsTest.Delete
Application.DisplayAlerts = True
End If
'Set doExist = wb.Worksheets.Add(after:=wb.Sheets(wb.Sheets.Count)) 'Edit of Edit, the later call to Charts.Add does this for you
'doExist.Name = strSheetName 'Edit of Edit, no need to return anything
End Function
Copying an existing password protected sheet to a new workbook as an unprotected sheet gives the following error when user tries to type in data in the new worksheet.
Error: "the cell or chart you're trying to change is on a protected sheet"
Click OK on the error message.
Please note that this error happens only once. click OK on the pop up error message and type again, then excel allows you to type data in the cells and save the sheet.
We have an excel (format .xls) file currently being used to create another excel spreadsheet when a button on a form in the same spreadsheet is clicked. It basically copies one password protected blank sheet (a template) to a new workbook as an unprotected sheet. The code below used to work with excel 2007(using .xls format). We recently upgraded from excel 2007 to excel 2013 and the problem appeared.
Private Sub cmd_Click()
Dim jBook As Workbook
Dim jsheet As Worksheet
CurrentWorkBook = ActiveWorkbook.Name
Workbooks(CurrentWorkBook).Unprotect jWorksheetPassword
'catch all for errors
On Error GoTo ErrEnd
Dim orginalScreenUpdating As Boolean
orginalScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
If Range("Language").Value = "2" Then
'French
Set jsheet = TemplateFR
Else
'english
Set jsheet = TemplateEN
End If
jsheet.Visible = xlSheetHidden
'jSheet.Visible = xlSheetVisible
'Delete this line
jsheet.Unprotect jWorksheetPassword
Set jBook = Workbooks.Add(xlWBATWorksheet)
jsheet.Copy After:=jBook.Sheets(1)
jBook.Sheets(2).Visible = xlSheetVisible
Application.DisplayAlerts = False
jBook.Sheets(1).Delete
Application.DisplayAlerts = True
jsheet.Visible = xlSheetVeryHidden
'Delete this line
jBook.Sheets(1).Unprotect jWorksheetPassword
'Delete this line
'jsheet.Protect Password:=jWorksheetPassword
NoErrEnd:
Workbooks(CurrentWorkBook).Protect Password:=jWorksheetPassword, Structure:=True, Windows:=False
Application.ScreenUpdating = orginalScreenUpdating
Unload Me
Exit Sub
ErrEnd:
Workbooks(CurrentWorkBook).Protect Password:=jWorksheetPassword, Structure:=True, Windows:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox DataTable.Range("MSG4").Value, vbCritical, DataTable.Range("MSG4TITLE").Value
Unload Me
End Sub
The following lines of code activate the original workbook and this somehow clears the protection of the copied sheet with excel 2013 only. On Excel 2007 this causes the original workbook to be activated and confuses users, hence the check for 2013.
If Application.Version = "15.0" Then
Workbooks(CurrentWorkBook).Activate
'jBook.Activate
End If
This is a hack that happens to work. If some one finds a better solution please do post it here as well.
The full code listing is as follows:
Private Sub cmd_Click()
Dim jBook As Workbook
Dim jsheet As Worksheet
CurrentWorkBook = ActiveWorkbook.Name
Workbooks(CurrentWorkBook).Unprotect jWorksheetPassword
'catch all for errors
On Error GoTo ErrEnd
Dim orginalScreenUpdating As Boolean
orginalScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
If Range("Language").Value = "2" Then
'French
Set jsheet = TemplateFR
Else
'english
Set jsheet = TemplateEN
End If
jsheet.Visible = xlSheetHidden
Set jBook = Workbooks.Add(xlWBATWorksheet)
jsheet.Copy After:=jBook.Sheets(1)
jBook.Sheets(2).Visible = xlSheetVisible
Application.DisplayAlerts = False
jBook.Sheets(1).Delete
Application.DisplayAlerts = True
If Application.Version = "15.0" Then
Workbooks(CurrentWorkBook).Activate
'jBook.Activate
End If
jsheet.Visible = xlSheetVeryHidden
NoErrEnd:
Workbooks(CurrentWorkBook).Protect Password:=jWorksheetPassword, Structure:=True, Windows:=False
Application.ScreenUpdating = orginalScreenUpdating
Unload Me
Exit Sub
ErrEnd:
Workbooks(CurrentWorkBook).Protect Password:=jWorksheetPassword, Structure:=True, Windows:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox DataTable.Range("MSG4").Value, vbCritical, DataTable.Range("MSG4TITLE").Value
Unload Me
End Sub