I have looked up the question and have seen several solutions addressing things like Select or having protected worksheets, none of which apply to me here.
For various reasons, I can't post the entire code, but I will give a description of what it does and post the exact sub that is giving me issues.
I have a Macro that generates a number of worksheets based on the Month and Year input by the user (so "1" - "31" or "1" - "30" etc). To generate these worksheets, the macro makes copies of a worksheet fittingly named "EXAMPLE". One thing that is copied is a picture (just a rectangle with the word 'Export' on it) that has a macro attached to it.
I recently made what I thought was a cosmetic change by moving the location of this picture, since then, when I run the macro I get an error:
"Run-time error '1004':
Microsoft Excel cannot paste the data."
And options for 'End' 'Debug' and 'Help'
If I select 'Debug' it points me to a second macro which is called during the process of the generation macro'
Sub CopyAllShapes()
Dim ws As Worksheet
' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")
' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
Sheets("EXAMPLE").Shapes("Picture 1").Copy
ws.Range("J62").PasteSpecial
ws.Shapes("Picture 1").OnAction = "Export"
End If
Next ws
Application.CutCopyMode = xlCopy
End Sub
The Debug option highlights the line
ws.Range("J62").PasteSpecial
What really confuses me is that if I select 'End' instead of 'Debug', the macro stops, but all the the sheets have had the picture pasted as well as the Export Macro assigned and everything works as expected. If I were the only person using this, it would be a minor annoyance, but this document is used by many people that can't reliable be told to "just ignore" the error. Since the macro is functioning as expected, how can i troubleshoot what is causing the problem and make the error go away?
As I said, I can't post the entire macro, but I can post some bits and pieces if anyone needs more info.
Not a pure fix, but this code will retry the Copy/Paste if it fails (up to 3 times), instead of just dropping it:
Const MaxRetries AS Long = 3
Sub CopyAllShapes()
Dim ws As Worksheet
Dim TimesRetried As Long
' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")
' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
TimesRetried = 0
CopyExampleShape:
On Error Resume Next
Sheets("EXAMPLE").Shapes("Picture 1").Copy
ws.Range("J62").PasteSpecial
'If the Copy/Paste fails, retry
If Err Then
On Error GoTo -1 'Clear the Error
'Don't get stuck in an infinite loop
If TimesRetried < MaxRetries Then
'Retry the Copy/paste
TimesRetried = TimesRetried + 1
DoEvents
GoTo CopyExampleShape
End If
End If
On Error GoTo 0
ws.Shapes("Picture 1").OnAction = "Export"
End If
Next ws
Application.CutCopyMode = xlCopy
End Sub
I have come across a similar issue before, and it was been down to another program (in one case Skype) reacting to data being added to the Clipboard by "inspecting" it. That then briefly locked the clipboard, so the Paste/PasteSpecial operation failed. This then caused the Clipboard to be wiped clean... All without Excel doing anything wrong.
"It is possible to commit no mistakes and still lose. That is not a weakness; that is life." ~ Jean-Luc Picard
On moving to Office 365 and Win10 (can't say which of those was the culprit) I found a bunch of existing macros which would give that same error when trying to paste a copied image onto a worksheet.
When entering debug, the "paste" line would be highlighted, but if I hit "Continue" it would (after one or two attempts) run with no errors.
I ended up doing this:
'paste problem fix
Sub PastePicRetry(rng As Range)
Dim i As Long
Do While i < 20
On Error Resume Next
rng.PasteSpecial
If Err.Number <> 0 Then
Debug.Print "Paste failed", i
DoEvents
i = i + 1
Else
Exit Do
End If
On Error GoTo 0
i = i + 1
Loop
End Sub
...which looks like overkill but was the only reliable fix for the problem.
EDIT: cleaned up and refactored into a standalone sub.
Just wanted to let everyone know I have found a (sort of) solution. Based on the answers/comments from Tim Williams and PeterT I modified the code to look like this:
Sub CopyAllShapes()
Dim ws As Worksheet
' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")
' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
Sheets("EXAMPLE").Shapes("Picture 1").Copy
On Error Resume Next
ws.Range("J62").PasteSpecial
On Error Goto 0
ws.Shapes("Picture 1").OnAction = "Export"
End If
Next ws
Application.CutCopyMode = xlCopy
End Sub
This has successfully ignored the error and everything is working properly now! Thanks everyone for your help, hopefully this aids someone else in the future!
Related
I am trying to automate data with a master wookbook. When I open the workbook I want a msg box to appear and clear the contents of specific columns in tables in one of the worksheets. I keep getting the "Application-defined or object-defined error". This is the code in my "This workbook" section:
Option Explicit
Sub Workbook_Open()
Dim answer As Integer
answer = MsgBox("Do you want to clear the totals?", vbYesNo + vbQuestion, "Clear Totals")
If answer = vbYes Then
Call Sheet1.ClearContents_1
End If
End Sub
This is my Sheet1 code:
Sub ClearContents_1()
Call Loop_Clear_C
Call Loop_Clear_M
Call Clear_S
End Sub
Sub Loop_Clear_C()
For i = 1 To Range("UserTable79").Rows.Count
Range("UserTable79[Total]")(i) = 0
Next i
End Sub
Sub Loop_Clear_M()
For i = 1 To Range("ServiceTable79").Rows.Count
Range("ServiceTable79[Total]")(i) = 0
Next i
End Sub
Sub Clear_S()
Range("TotalTable79[Actual Total]").ClearContents
End Sub
They worked separately but not together. The msg box comes up but doesn't run the Sheet1 code. How do I call upon this sheet code?
Edit: The Sheet1 code no longer works either.
Often the "Application-defined or object-defined error" message comes up when the range that you're referring to doesn't exist. If you click on Sheet1 to activate it and then try to use the Immediate panel to perform an operation on the ranges you're referring to (e.g. try entering Range("UserTable79").Select) do you get an error?
Explicitly specifying the worksheet when calling the function from the "ThisWorkbook" section (e.g. if the worksheet is named "SheetName" then specifying Call ThisWorkbook.Sheets("SheetName").ClearContents_1 rather than Call Sheet1.ClearContents_1) can help.
Also - note that you can clear the entire table ranges or entire columns in Loop_Clear_C and Loop_Clear_M with ClearContents or EntireColumn.ClearContents if that's easier.
I am using a macro to copy a sheet (called Copy) from the source (called Book1.xlsm) to copy a sheet to the target workbook (called Book2.xlsb). Before I do the copy, I call a macro in the target (Book2.xlsb) to make certain it's an older version.
Excel crashes or gives an Automation Error Exception Occurred or just a crash when the target workbook is closed (with both saving or not saving).
When I do this from a blank xlsm or xlsb, there is no crash. I use any of 10 real world spreadsheets (from 2MB up to 34MB xlsb), and it happens all the time.
I've spent days trying to make the minimal viable example crash with a smaller spreadsheet as a target with no luck.
The target spreadsheets contain no vba code (just formulas) except for the module that gets imported from the source.
My example has Button1 to make a single copy. 1 field exists for version number (Cell A2).
I am left with the impression that calling code in another workbook is just a bad idea or I'm missing something fundamental. If the call to the target worksheet is not made, everything runs fine.
Main Question: Is running code from another workbook just a bad idea or am I missing something?
Before saving I've tried:
Application.Calculate
Do Until (Application.CalculationState = xlDone) And _
(Application.Workbooks.Count <> 1) And _
(Application.VBE.VBProjects.Count
DoEvents
Loop
TmpTgtWorkbook.Close False
Set TmpTgtWorkbook = Nothing
Before opening, I always make certain only the source workbook is open.
Option Explicit
Function GetVersion(aWorkbook As Workbook) As Double
Dim TmpSheet As Worksheet
GetVersion = 0
On Error Resume Next
Set TmpSheet = aWorkbook.Sheets("Copy")
On Error GoTo 0
If TmpSheet Is Nothing Then
Exit Function
End If
GetVersion = CDbl(TmpSheet.Range("B1"))
End Function
Sub CopyToBook2()
Dim TmpTgtWorkbook As Workbook
Dim TmpSrcVersion As Double
Dim TmpTgtVersion As Double
Const kWorkbookStr = "Book2.xlsb"
TmpSrcVersion = GetVersion(ThisWorkbook)
ThisWorkbook.VBProject.VBComponents("Module1").Export "C:\Temp\Module1"
Set TmpTgtWorkbook = Application.Workbooks.Open(Filename:=ThisWorkbook.Path + "\" + kWorkbookStr)
Err.Clear
On Error Resume Next
'Run the GetVersion Function from the Opened Workbook.
'Removing this line takes away crashes.
TmpTgtVersion = Application.Run(kWorkbookStr + "!GetVersion", TmpTgtWorkbook)
If Err.Number <> 0 Then
Err.Clear
TmpTgtVersion = 0
End If
On Error GoTo 0
If TmpSrcVersion > TmpTgtVersion Then
On Error Resume Next
TmpTgtWorkbook.VBProject.VBComponents.Remove TmpTgtWorkbook.VBProject.VBComponents("Module1")
Application.DisplayAlerts = False
TmpTgtWorkbook.Sheets("Copy").Delete
Application.DisplayAlerts = True
On Error GoTo 0
TmpTgtWorkbook.VBProject.VBComponents.Import "C:\Temp\Module1"
ThisWorkbook.Sheets("Copy").Copy TmpTgtWorkbook.Sheets(1)
TmpTgtWorkbook.ChangeLink ThisWorkbook.Name, TmpTgtWorkbook.Name, xlLinkTypeExcelLinks
TmpTgtWorkbook.Close True
Else
TmpTgtWorkbook.Close False
End If
End Sub
Automation Error Exception Occurred and then a crash or just a crash.
Also, you need to run the code by clicking Button1 2x or more to first copy the module to the target.
I went with Abdes Sabor's workaround. Thanks for that.
Also, considering a small version system for the future which code modules have the CodeModuleName_Major_Minor version format.
My Main Question: Is running code from another workbook just a bad idea or am I missing something?
Unfortunately, all evidence point to Yes. Running a function using Application.Run in another worksheet seems to be bad and potentially corrupts spreadsheets.
I've seen a lot of posts about this OLE action error, but the difference here is that the macro that I am running isn't importing/exporting any data and isn't triggering actions in any other program (at least not intentionally), which is what I've come to learn is generally the cause. Here is the VBA that generates the error:
Sub DeleteRows()
Dim varResponse As Variant
varResponse = MsgBox("This will permanently delete selected rows. Do you wish to continue?", vbYesNo, "WARNING")
If varResponse <> vbYes Then Exit Sub
Set Rs = Selection
For i = 1 To Selection.Rows.Count
If Range(Rs.Address).EntireRow.Cells(i, 12) <> "d" Then
MsgBox "Selection contains cells that can not be removed. Revise selection.", vbExclamation, "Invalid Selection"
Exit Sub
End If
Next
For Each Worksheet In ActiveWorkbook.Worksheets
Worksheet.Unprotect
Next
ActiveWorkbook.Worksheets("backup_estimate").Cells.Clear
ActiveWorkbook.Worksheets("backup_actual").Cells.Clear
ActiveWorkbook.Worksheets("backup_invoice").Cells.Clear
sourceOld = Selection(1).Row
sourceSize = Selection.Rows.Count
Worksheets("Estimate").Range(Rs.Address).EntireRow.Copy Destination:=Worksheets("backup_estimate").Range("A1")
Worksheets("Actual Cost").Range(Rs.Address).EntireRow.Copy Destination:=Worksheets("backup_actual").Range("A1")
Worksheets("Invoice Tracking").Range(Rs.Address).EntireRow.Copy Destination:=Worksheets("backup_invoice").Range("A1")
Sheets(Array("Estimate", "Actual Cost", "Invoice Tracking")).Select
Range(Rs.Address).EntireRow.Select
Selection.Delete Shift:=x1Up
ActiveSheet.Select
For Each Worksheet In ActiveWorkbook.Worksheets
Worksheet.Protect
Next
End Sub
The purpose of the macro is to delete the same selection of data and rows across 3 of the 6 sheets in this specific workbook, and shift all remaining data up.
When triggering the macro, it will more often than not freeze the instance of excel and give me that error about 10-20 seconds later (it doesn't happen every time). For reference, the "backup_estimate" and other backup sheets are strictly temporary data storage for use by another "undo last action" macro that I have set up.
I do have a single plug-in that I use periodically (blue-beam), but I've encountered this error with the plugins all disabled AND the "ignore other applications that use DDE" option checked (one of the fixes suggested on another post).
I’m very new to Excel VBA but managed to create three buttons in a staff timesheet. All buttons work as needed, however, one particular button is causing random issues – about 90% of the time it works, but from time to time it will crash Excel or give an error such as runtime error '-2147417848 (800 10 108)': Automation error The object invoked has disconnected from its clients. Other times it’s a similar message, saying Method ‘Insert’ of object ‘Range’ failed.
It’s happening in different versions of Excel on different computers. The task is not complex but I’m stumbling with my VBA knowledge.
The user clicks the button to set up each formatted row in the sheet called “Timesheet”, i.e. clicking the button in “Timesheet” copies a row from sheet4 (formatted and containing formulae) and inserts it into the “Timesheet” above the button.
I’d be very grateful if someone could suggest alternative code that won’t crash Excel - many thanks in advance!
Sub NewSlot()
' NewSlot Macro used in Timesheet
'
'turn protection off
Worksheets("Sheet4").Unprotect Password:="mypasswd"
Worksheets("Timesheet").Unprotect Password:=" mypasswd "
' select row 8 in sheet4
Sheets("Sheet4").Select
Rows("8").Select
Selection.Copy
' go back to timesheet
Sheets("Timesheet").Select
' insert copied row
Dim r As Range
Set r = ActiveSheet.Buttons(Application.Caller).TopLeftCell
Range(Cells(r.Row, r.Column), Cells(r.Row, r.Column)).Offset(0, 0).Select
Selection.Insert shift:=xlDown
Application.CutCopyMode = False
'turn protection on
Worksheets("Sheet4").Protect Password:=" mypasswd "
Worksheets("Timesheet").Protect Password:=" mypasswd"
End Sub
If you are going to use VBA to repeatedly modify a protected worksheet, unprotect it then protect it once with UserInterfaceOnly:=True.
sub protectOnce()
worksheets("Timesheet").unprotect password:="mypasswd"
worksheets("sheet4").unprotect password:="mypasswd"
worksheets("Timesheet").protect password:="mypasswd", UserInterfaceOnly:=True
worksheets("sheet4").protect password:="mypasswd", UserInterfaceOnly:=True
end sub
After that has been done once you will not have to unprotect to modify with VBA. If you have to unprotect it for another reason, reprotect it with with UserInterfaceOnly:=True.
This cuts your NewSlot code down significantly. It is considered 'best practise' to avoid using Select and Activate, particularly across worksheets.
Sub NewSlot()
' select row 8 in sheet4
workSheets("Sheet4").Rows("8").Copy
' go back to timesheet
with workSheets("Timesheet")
' insert copied row
Dim r As Range
Set r = .Buttons(Application.Caller).TopLeftCell
.Cells(r.Row, "A").entirerow.Insert shift:=xlDown
end with
End Sub
I have a pair of buttons ('continue' and 'back') which move a user forward and back worksheets.
The forward button seems to be able to move forward through visible sheets with no trouble, skipping hidden sheets fine.
The back button however, fails to do anything if there is a hidden sheet between the active sheet and the previous visible sheets.
I'm confused because the code for the two is practically identical:
Forward: (works fine)
Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
End Sub
Back: (fails at hidden sheet)
Sub MoveBack()
On Error Resume Next
Sheets(ActiveSheet.Index - 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
End Sub
Each button is bound to the subs above as suitable.
Interesting! It looks like if you try to activate a hidden worksheet, it defaults to the next highest index. So that's why it works going up, but not going down. I wrote a routine that checks whether there's a lower visible sheet, and if so, moves to it:
Sub MoveBack()
Dim PrevVisibleIndex As Long
PrevVisibleIndex = ActiveSheet.Index
With ThisWorkbook
Do
PrevVisibleIndex = Application.WorksheetFunction.Max(PrevVisibleIndex - 1, 1)
Loop Until .Worksheets(PrevVisibleIndex).Visible = True Or PrevVisibleIndex = 1
.Worksheets(PrevVisibleIndex).Activate
End With
End Sub