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.
Related
I am trying to change the macro assigned to a button from a different sheet than where the button is. This is how far I've gotten:
Sub Macro1()
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.OnAction = "Macro2"
End Sub
However, the above code requres me to be on the active sheet. I have tried the following:
Sub Macro1()
Sheet1.Shapes.Range(Array("Button 1")).Select
Selection.OnAction = "Macro2"
End Sub
However, this will give me an "Object doesn't support this property or method" error.
Why doesn't it work when "ActiveSheet" is replaced with "Sheet1"?
And why can't I collect the two lines of code into one line?:
Sub Macro1()
Sheet1.Shapes.Range(Array("Button 1")).OnAction = "Macro2"
End Sub
Any help would be appreciated!
Please, simple try:
Sheet1.Shapes("Button 1").OnAction = "Macro2"
Of course, a macro named "Macro2" should exist in a standard module. If in a sheet code module, the sheet CodeName is necessary in front of the macro name ("Sheet1.Macro2")...
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!
I want to confirm with a popup message and sound effect in a protected Excel 2010 worksheet when the values of two cells are the same. I have tried this formula in data validation:
IF(D4=D5,beepnow(),"")
but it does not run. Can anyone assist with the formula or a VBA code replacement instead? Thanks!
Here's a program that will run whenever you change to the worksheet... which may get pretty annoying... You should get the idea though and be able to modify it to fit your needs.
Private Sub Worksheet_Activate()
If Range("D4").Value = Range("D5").Value Then
Beep
MsgBox "Equal", vbInformation, "Check"
End If
End Sub
You should just be able to copy and paste it into your worksheet class.
If you go to the VB COde Window, select the relevant sheet, you can have the following
Private Sub Worksheet_Change(ByVal Target As Range)
If (Range("D4:D4").Cells(1, 1)) = Range("D5:D5").Cells(1, 1)) Then
MsgBox ("Hi")
End If
End Sub
The worksheet activate will run the code when you select this sheet.
The Worksheet_change will run the code when you make a change in this sheet.
IF you want to have the check only when D4/D5 is modified
If Target.Address = "$D$4" Or Target.Address = "$D$5" Then
If (Range("D4:D4").Cells(1, 1)) = Range("D5:D5").Cells(1, 1)) Then
MsgBox ("Hi")
End If
End If
I have created a Named Range using the Name Manager. It is called Vol_Check. It is scoped as Workbook.
If it is scoped as workbook, why can I not see it in VBA code from other sheets or ThisWorkbook or Modules.
Even when I try to reference it directly, it will not work.
Here is a code example that I cannot make work.
Private Sub CommandButton1_Click()
If ThisWorkbook.Sheets("sheet1").Range("Vol_Check").Value <> 1 Then
MsgBox ("Some message ")
End If
End Sub
If you are using a Named Range "Vol_Check", then use the code below to read a value from one of the cells inside the Named Range.
In the example, let's say your Named Range includes Range B2:B2, then the code line Range("Vol_Check")(1, 1) refers to Cell B2
Private Sub CommandButton1_Click()
' just for debug - shows the first row and first column in the Named Range
MsgBox Range("Vol_Check")(1, 1)
If Range("Vol_Check")(1, 1) <> 1 Then
MsgBox ("Some message ")
End If
End Sub
Try using Worksheet.Evaluate instead:
Private Sub CommandButton1_Click()
If ThisWorkbook.Sheets(1).Evaluate("Vol_Check").Value <> 1 Then
MsgBox "Some message "
End If
End Sub
Problem solved.
It turns out that I was not defining the Named Range properly with the Name Manager tool. Even tho I was marking it 'Workbook' in scope, my other error was messing it up.
Thanks everyone.
Rich
I have an Excel workbook in which I have tabs representing dates along with sum in each tab. Although I can take the sum of all these in the final sheet, I want a formula/macro to get the sum in the total named sheet, when a new spreadsheet is being added.
Note:- the cell in all would remain the same (E56)
I do not understand what you are attempting. Until the user has placed information in the new sheet that results in a value in E56, I see little point to adding the value of NewSheet!E56 to the total sheet.
However I suspect you need to use events. Below are a number of event routines which must be placed in the Microsoft Excel Object ThisWorkbook for the workbook. These just output to the Immediate window so you can see when they are fired. Note: several can be fired for one user event. For example, creating a new worksheet, triggers: "Create for new sheet", "Deactivate for old sheet" and "Activate for new sheet".
Do not forget to include
Application.EnableEvents = False
Application.EnableEvents = True
around any statement within one of these routine that will trigger an event.
Perhaps you need to use SheetDeactivate. When the users leaves a sheet, check for a value in E56. If present, check for its inclusion in the totals sheet. Have a play. Do what your users do. Add to these routines to investigate further. Good luck.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Debug.Print "Workbook_SheetActivate " & Sh.Name
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call MsgBox("Workbook_BeforeClose", vbOKOnly)
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Debug.Print "Workbook_SheetChange " & Sh.Name & " " & Source.Address
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Debug.Print "Workbook_SheetDeactivate " & Sh.Name
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Debug.Print "Workbook_NewSheet " & Sh.Name
End Sub
Sub Workbook_Open()
Debug.Print "Workbook_Open"
End Sub
Extra section in response to clarification of requirement
The code below recalculates the grand total of cell E56 for all worksheets except TOTAL and stores the result in worksheet TOTAL every time the workbook is opened and every time the user changes the current worksheet.
It is difficult to get consistent timings with Excel but according to my experimentation you would need between 500 and 1,000 worksheets before the user would notice a delay switching worksheets because of this recalculation.
I am not sure if you know how to install this code so here are brief instructions. Ask if they are too brief.
Open the relevant workbook.
Click Alt+F11. The VBA editor displays. Down the left you should see the Project Explorer. Click Ctrl+R if you do not. The Project Explorer display will look something like:
.
VBAProject (Xxxxxxxx.xls)
Microsoft Excel Objects
Sheet1 (Xxxxxxxxx)
Sheet10 (Xxxxxxxxx)
Sheet11 (Xxxxxxx)
:
ThisWorkbook
Click ThisWorkbook. The top right of the screen with turn white.
Copy the code below into that white area.
No further action is required. The macros Workbook_Open() and Workbook_SheetDeactivate() execute automatically when appropriate.
Good luck.
Option Explicit
Sub CalcAndSaveGrandTotal()
Dim InxWksht As Long
Dim TotalGrand As Double
TotalGrand = 0#
For InxWksht = 1 To Worksheets.Count
If Not UCase(Worksheets(InxWksht).Name) = "TOTAL" Then
' This worksheet is not the totals worksheet
If IsNumeric(Worksheets(InxWksht).Range("E56").Value) Then '###
TotalGrand = TotalGrand + Worksheets(InxWksht).Range("E56").Value
End If '###
End If
Next
'Write grand total to worksheet TOTAL
' ##### Change the address of the destination cell as required
Worksheets("TOTAL").Range("D6").Value = TotalGrand
End Sub
Sub Workbook_Open()
' The workbook has just been opened.
Call CalcAndSaveGrandTotal
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
' The user has selected a new worksheet or has created a new worksheet.
Call CalcAndSaveGrandTotal
End Sub
I know this is the programming forum, but this particular "need" seems to be solvable without all the plumbing.
I like the old hidden FIRST and LAST sheets trick.
Create a sheet called First
Create a sheet called Last
Place your current data sheets between these two sheets.
Hide the sheets First and Last
Now you can use 3D formulas to sum cells from all these sheets, like so:
=SUM(First:Last!E56)
Now just add sheets to your workbook AFTER the last visible data sheet and Excel will still slip it in ahead of the hidden LAST sheet, so your formula just expands itself that way