I have an excel project where I have tables in sheets (a basic database). The aim is to track the progress of pupils regarding different objectives they have to fulfill in different matters (and sub, sub-sub and sub-sub-sub-matters). I am trying to make a UserForm for the teacher to select a specific pupil, matter, sub...sub-mater set and get the level achieved in the objectives corrsponding to that specific set. I am at the stage of selecting a set of parameters :
UserForm, not finished
My problem is : in the case I select a matter, then a sub-matter, and then come back to change the main matter, Excel is doing something super weird. It stops a Sub after a specific line and .Activate does not work anymore for selecting a sheet in other Subs:
Sub ListMatieres_Change()
If Not IsNull(ListMatieres.Column(0)) Then
With Worksheets("S-matiere_tmp")
.Activate
.UsedRange.Delete 'Stops after this line------------------------------------------------
getRows("S-matiere", "s_matiere", "Parent", ListMatieres.Column(0)).Copy
.Activate
Range("A1").PasteSpecial Paste:=xlPasteValues
ListSmatieres.RowSource = .UsedRange.Address
End With
Sheets("Accueil").Activate
End If
ListSsmatieres.RowSource = ""
ListSssmatieres.RowSource = ""
End Sub
Sub ListSmatieres_Change()
If Not IsNull(ListSmatieres.Column(0)) Then
With Sheets("SS-matiere_tmp")
.Activate
.UsedRange.Delete 'Getting an error here, because the .activate has not worked----------
getRows("SS-matiere", "ss_matiere", "Parent", ListSmatieres.Column(0)).Copy
.Activate
Range("A1").PasteSpecial Paste:=xlPasteValues
ListSsmatieres.RowSource = .UsedRange.Address
End With
Sheets("Accueil").Activate
End If
ListSssmatieres.RowSource = ""
End Sub
Changing the matter triggers the first Sub, which triggers the second.
Here is a link for the .xlsm file : Drive link
I am really clueless, because the error given by Excel is only a consequence of some unexpected behavior I cannot explain...
Any help is welcome !
Related
I have been working on debugging this code and I am running into an issue where the code runs fine (no errors) but the changes it is supposed to be making aren't happening in the actual sheet.
What the code is supposed to do:
The goal is to be able to check on saving if any cells have been changed. If they have, it locks all cells with non-blank values and protects the sheet to avoid having those cells edited in future instances.
Here is the code itself:
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sMSG As String
sMSG = "Saving the workbook will lock the cells you have entered data into." & vbLf
sMSG = sMSG & "Do you want to go ahead?"
If Not bRangeEdited Then GoTo Xit
If Not Me.ReadOnly Then
Sheet1.Unprotect "password"
With Sheet1.Range("A1:I20")
If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
Cancel = True
GoTo Xit
End If
If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
.SpecialCells(xlCellTypeConstants).Locked = True
bRangeEdited = False
End If
End With
Sheet1.Protect Password:="password", UserInterFaceOnly:=True, DrawingObjects:=False, AllowFiltering:=True
End If
Xit:
End Sub
This is based on a common piece of code found on multiple forums which seems to work for everyone else. This code USED to work and then something broke it. I thought it was the Range being wrong (which I fixed) but that didn't solve the problem.
What I've tried:
Running the separate code lines in the Immediate window - everything runs properly
Stepping through the code with F8 and debug.print to check what is being pulled by .SpecialCells(xlCellTypeBlanks).Address - this pulls the entire input range every time, regardless of what is in the cells but pulls the correct range when run in the Immediate window
Stepping through also produces no errors and shows that every if and with statement is working correctly
Running the code from different locations (Sheet1, Module, ThisWorkbook) including separating into multiple subs across different locations - no change
Running the code on a brand-new test workbook with no other macros - still doesn't work
Different methods for locking the cells such as a loop through all cells in the range instead of using SpecialCells - didn't work
Even the Protect/Unprotect lines are not working which leads me to believe that the code is somehow disconnected from the worksheet itself.
Anyone have any ideas how that is possible? Or how to fix it?
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 have a workbook called "Data" with raw data on the "Unprocessed" sheet.
I am trying to create a sheet for every agent, called "agent" (this will be changed for every agent but for ease we will call it this for now) that pulls raw data, one row at a time, into their work area from the data workbook.
I need cells A2:M2 cut from the "Unprocessed" sheet and pasted into A4:M4 of the "agent" sheet.
I get "out of range" error. I tie this sub to a button the agents hit to bring up a new row of data.
Sub newcancel_click()
If Range("M4").Value = "EN" Then
MsgBox "You must Complete Previous cancellation.", vbCritical, "Error"
Else
Sheets("Uncompleted").Select
Range("A1:L1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Jeremy").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("Uncompleted").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete
Shift:=xlUp
Sheets("Jeremy").Select
End If
End Sub
After this, I will need to create a sub to move the data from the work area to a "Processed" sheet on the "Data" book. I am comfortable that I will be able to write this sub once I get the first one working.
As for your current code, the following should work better.
Sub Newcancel_click2()
If ThisWorkbook.Sheets(1).Range("M4").Value = "EN" Then
MsgBox "You must Complete Previous cancellation.", vbCritical, "Error"
Else
Sheets("Jeremy").Range("B4:M4").Value = Sheets("Uncompleted").Range("A1:L1").Value
Sheets("Uncompleted").Rows(1).EntireRow.Delete shift:=xlUp
End If
End Sub
An interesting read for you: How to avoid using select in VBA
As for your issue, "Subscript out of range" might mean some of your ranges aren't defined properly. Your selection might not match the copy destination, or (most likely) the sheet you're referring to doesn't exist (either a typo or you've not created it yet).
To refer to another workbook you can use Workbooks("Workbook name").Sheets("Sheet name").Range etc. You can use activeworkbook to refer to the currently active workbook (not recommended as per above link to avoid using select) and you can refer to the workbook your VBA code is in with Thisworkbook, this is easier than using two statements: Workbook("Name for this one") and Workbook("Name for the other one")
In your case this would look something like:
Sub Newcancel_click2()
If ThisWorkbook.Sheets(1).Range("M4").Value = "EN" Then
MsgBox "You must Complete Previous cancellation.", vbCritical, "Error"
Else
Workbook("Agent").Sheets("Jeremy").Range("B4:M4").Value = Thisworkbook.Sheets("Uncompleted").Range("A1:L1").Value
Thisworkbook.Sheets("Uncompleted").Rows(1).EntireRow.Delete shift:=xlUp
End If
End Sub
(please note I made an approximation to most of your workbook and sheet names, please check and replace with your actual names)
Apologies if this question is elementary, i'm not great at VBA. I have 3 separate codes that i want to run one after the other at the click of a button. So i have the master code titled UpdateLinks that is supposed to call them. The first 2 (PreSelect & UpdateLinksCode)run the 3rd (PostSelect) doesn't. Individually they all work.
The purpose is to update links to external excel workbooks without having to manually enter the password. That is what the UpdateLinksCode macro is for. However, if the linked source does not require a password the UpdateLinksCode will drop the password in whatever cell was selected before running. Hence the PreSelect & PostSelect - supposed to delete the password and prevent exposure.
This is the master code:
Sub UpdateLinks()
Call PreSelect
Call UpDateLinksCode
Call PostSelect
End Sub
The individual ones are as below:
Sub PreSelect()
Sheets("Sheet1").Select
Range("A1").Select
End Sub
Sub UpDateLinksCode()
Const PWord As String = "password"
Dim xlLinks
Dim i As Integer
xlLinks = ThisWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(xlLinks) Then
For i = 1 To UBound(xlLinks)
SendKeys PWord & "{Enter}"
ThisWorkbook.UpdateLink Name:=xlLinks(i)
Next i
End If
End Sub
Sub PostSelect()
Sheets("Sheet1").Select
Range("A1").Select
Selection.ClearContents
End Sub
It seems simple but i can't hack it.
Update: Appreciate all the input. I've now changed the code to sit in a module and refer to the worksheet by name. I've removed the call functions and separate codes and condensed it to the one. There are no errors when debugging or running through step by step.
However, same issue exists in that no further code will run following the 'send keys''. The "Range("A1").Select" needs to be in there because, something to do with the timing of the password request box popping up and the send keys inputting the password, causes half of the password to be typed into whichever cell is highlighted when the code is run. Therefore, i force it into cell A1 which has both background and text set to white.
Current code is as below:
Sub Update_links()
Worksheets("Staff Rota 2019").Unprotect "broncko"
Range("A1").Select
Dim PWord As String
PWord = "stevefinnan"
SendKeys PWord & "{Enter}"
ActiveWorkbook.UpdateLink Name:= _
"Y:\a - Staff Rota\Staff Rota 2019.xlsm", _
Type:=xlExcelLinks
Worksheets("Staff Rota 2019").Protect "broncko", DrawingObjects:=True,
Contents:=True, Scenarios:=True
end sub
This code must be in a worksheet code instead of a module since you are responding to a button event. The problem is that you select a different worksheet Sheets("Sheet1").Select and there must be some other code that gets run at that point.
Move the code to a module, and reference the specific worksheets directly (do not use the select statement).
for example:
Worksheets("Sheet1").Range("A1").ClearContents
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