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
Related
Please see the below VBA Code that I've came up with. Essentially, this is to open another workbook, Unmerge the Rows, Copy the Columns and Paste it into my Active Workbook. However after copy pasting, when the code runs to the CalculationAutomatic line, it takes around 15mins. Is there any other way to make it more efficient?
Thank you
Option Explicit
Sub ImportRemarks()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim PLPath As String
PLPath = Sheets("Instructions").Range("C16").Text
Dim wbThis As Workbook
Dim wbTarget As Workbook
Set wbThis = ActiveWorkbook
Set wbTarget = Workbooks.Open(PLPath)
wbTarget.Worksheets("Performance List").Select
Rows("1:2").Select
Selection.UnMerge
wbThis.Worksheets("keys").Range("I:I").Value =
wbTarget.Worksheets("Performance List").Range("F:F").Value
wbThis.Worksheets("keys").Range("J:L").Value =
wbTarget.Worksheets("Performance List").Range("P:R").Value
wbThis.Activate
Application.CutCopyMode = False
wbTarget.Close savechanges:=False
ActiveWorkbook.Sheets("Instructions").Select
Range("C22").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Maybe something like as follows for starters. Ideally, the optimization steps would go in their own subs. One to switch on optimization at the start and the other to return everything to how it was at the end (or on error).
As requested, this shows you how to remove the .Select parts of your code by using With statements. It also includes a safe exit, in case of error, to switch back on everything you disabled.
Option Explicit
Public Sub ImportRemarks()
Dim PLPath As String, wbThis As Workbook, wbTarget As Workbook
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo Errhand
Set wbThis = ThisWorkbook
Set wbTarget = Workbooks.Open(PLPath)
PLPath = wbThis.Worksheets("Instructions").Range("C16").Text
wbTarget.Worksheets("Performance List").Rows("1:2").UnMerge
With wbThis.Worksheets("keys")
.Range("I:I") = wbTarget.Worksheets("Performance List").Range("F:F")
.Range("J:L") = wbTarget.Worksheets("Performance List").Range("P:R")
End With
wbTarget.Close savechanges:=False
With wbThis
.Activate
' .Worksheets("Instructions").Range("C22").Activate '<=consider whether this is needed?
End With
Errhand:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
More info on optimization here:
https://www.thespreadsheetguru.com/blog/2015/2/25/best-way-to-improve-vba-macro-performance-and-prevent-slow-code-execution
http://www.cpearson.com/excel/optimize.htm
I do a report every day in which I have to copy and paste several sheets into a new workbook titled Report (today's date).
In my report I have 4 sheets : Customers, Orders, Country, ID.
Customer and Country are a simple copy and paste from the master file, but Orders and ID are filtered data from one of my sheets in the master file. Orders is filtered to "Complete" and Id is everything except ID 200 and 500.
I tried building a macro based on this solution found here :
http://www.hivmr.com/db/ack717pc8f88jpdsf7838pcaspkcsdmd
The copy and paste works but I am unable to copy and paste multiple sheets/ rename sheets and filter the data.
Edit:
Sub CopyInNewWB()
'has been tested
Dim newWS, WS As Worksheet
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Sheets("Sheet1")
Set newWS = Workbooks.Add.Sheets("Sheet1")
WS.Cells.Copy
newWS.Cells.PasteSpecial xlValues Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
No clue how your filtered sheets are set up, but this method will copy the sheets in your master exactly how they are currently filtered to a new workbook:
Sub CopyInNewWB()
Dim wbO As Workbook, wbN As Workbook
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wbO = ActiveWorkbook
Set wbN = Workbooks.Add
wbO.Sheets("Customers").Copy wbN.Sheets(1)
wbO.Sheets("Orders").Copy wbN.Sheets(2)
wbO.Sheets("Country").Copy wbN.Sheets(3)
wbO.Sheets("ID").Copy wbN.Sheets(4)
wbN.Sheets("Sheet1").Delete
wbN.Sheets("Customers").Activate
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
ErrHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
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
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
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