I want to insert a row that is copied from above line with formulas in it by double click. and when I turned on protect worksheet macro is not working. I tried the method of ActiveSheet.Unprotect Password:="1" but it is not working. Could any of you guide me what my mistake is and what the solution is?
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="1"
If [BusinessType] = "Operating Lease (Contract Based)" Then
Range("hide").EntireRow.Hidden = False
Else
Range("hide").EntireRow.Hidden = True
End If
ActiveSheet.Protect Password:="1"
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
ActiveSheet.Unprotect Password:="1"
'Updateby Extendoffice 20160725
Cancel = True
Target.Offset(1).EntireRow.Insert
Target.EntireRow.Copy Target.Offset(1).EntireRow
On Error Resume Next
Target.Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents
ActiveSheet.Protect Password:="1"
End Sub
One should be always careful when using Worksheet_Change event, because it gets triggered with every worksheet change. In this case, calling Target.Offset(1).EntireRow.Insert triggers the Worksheet_Change event. And the last step in the event is protecting the sheet, which throws an error on the next line Target.EntireRow.Copy Target.Offset(1).EntireRow. When this line of code runs, the sheet is protected, which throws an error.
Possible solutions:
Avoid using Worksheet_Change if possible.
Remove Sheet.protect() from the Worksheet_Change.
Disable events in the Worksheet_BeforeDoubleClick using Application.EnableEvents = False. However, i do not recommend doing this, as you have to make sure that events are enabled again (using proper error handling).
Related
I'm running a target intersect method in excel to prevent a user from pasting over validation cells, problem is, I didn't account for all the paste methods, and pastespecial overrides the cell validations.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I14:J1000")) Is Nothing Then
On Error Resume Next ' In case there's been no previous action
' Check if the last action was a paste
If Left(Application.CommandBars("Standard").Controls("&Undo").List(1), 5) = "Paste" Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End If
End Sub
I used the code below and binded it to Ctrl V, so that it matches the destination formatting, but it overrides the cell validation from the previous code:
Sub PasteWithDestinationFormatting()
ActiveCell.PasteSpecial (xlPasteValues)
End Sub
I'm assuming I need to change ="Paste" to a "PasteSpecial" but it didn't accomplish what I wanted it to do, most likely cause I didn't have the correct location of the PasteSpecial object.
Thanks for the help!
This question already has answers here:
Why MS Excel crashes and closes during Worksheet_Change Sub procedure?
(3 answers)
Closed 4 years ago.
I have reworked this macro for two days in a load of different ways to try to prevent steps from repeating but the range G2 step seems to run 3 or 4 times and the range G3 2 or 3 times. Does anyone have any ideas??
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then
Range("g4").Value = "Team"
Range("g3").Value = "Division"
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then
Range("G4").Value = "Team"
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
Call check
Exit Sub
End If
End Sub
Your Worksheet_Change has succumbed to three of the most common mistakes in an event driven worksheet/workbook sub procedure.
You are not disabling events while making modifications to the worksheet. Each change triggers another event and the Worksheet_Change tries to run on top of itself over and over until it crashes.
Target could be a single cell or many cells. You need to deal with the possibility of Target being many cells by using Intersect to only get the affected cells within your range of possibilities.
If you disable events for any reason, make sure to provide error control that turns them back on if everything goes south. Typically, this can be done just before exiting the Worksheet_Change but not if you are going to use Exit Sub.
Here is my version of your procedure.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4, G2:G4")) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim trgt As Range
For Each trgt In Intersect(Target, Range("D4, G2:G4"))
Select Case trgt.Address(0, 0)
Case "G2"
Range("G3:G4") = Application.Transpose(Array("Division", "Team"))
'call check is below
Case "G3"
Range("G4") = "Team"
'call check is below
Case "D4", "G4"
'call check is below
End Select
Next trgt
Call check
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Your code is in the Worksheet_Change event. Every time the worksheet is changed this event fires, including when your code changes it
Range("g4").Value = "Team"
Thus you're stuck in a potentially infinite loop. To avoid this disable events before making any changes
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' this turns events off
If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then
Range("g4").Value = "Team"
Range("g3").Value = "Division"
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then
Range("G4").Value = "Team"
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
Call check
Application.EnableEvents = True
Exit Sub
End If
Application.EnableEvents = True
End Sub
You might need to enable or disable events within the subs you're calling too.
BTW I'd check if you really need those Exit Subs, if not you can just disable events once at the start and re-enable again at the end.
I have a password protected sheet, with some unlocked cells that user can chage.
Once the user changes any value, it automatically should make changes to other unlocked cells by vba code. This works fine if the sheet is unlocked, but not if it's protected.
example of code:
In Workbook_Open() I set UserInterfaceOnly attribute to TRUE:
Sheets("Sheet Name").Protect Password:="123456", UserInterFaceOnly:=True, Contents:=True
Sheet code: Set date.01 value into date.02 cell if date.01 changes
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("date.01")) Is Nothing Then
Worksheets("Sheet Name").Range("date.02") = Target
End If
End Sub
cells "date.01" and "date.02" are unlocked.
Why can't I update them?
EDIT:
Is SelectionChange event the best option to change cell values? And is it ok to do the assignment like this:
Worksheets("Sheet Name").Range("date.02") = Target
I can see that the changes are applieD when the original cell get the focus back.
What I really want to do is to give a group of cells in different sheets the same value anytime any of them are changed by the user.
SOLVED.
My bad, I was using
Worksheet_SelectionChange
instead of
Worksheet_Change
I also had to use this to prevent any errors.
Application.EnableEvents = False
<CODE>
Application.EnableEvents = True
There was no need of using UserInterfaceOnly as all cells/ranges are unlocked.
you can simply check it's something to do with protection.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("date.01")) Is Nothing Then
Sheets("Sheet Name").unProtect Password:="123456"
`Worksheets("Sheet Name").Range("date.02") = Target`
`Sheets("Sheet Name").Protect Password:="123456", UserInterFaceOnly:=True`
End if
End Sub
Do you apply validation through VBA
The event method to use is Worksheet.Change Event
https://msdn.microsoft.com/en-us/library/office/ff839775.aspx
And the code was like:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("date.01")) Is Nothing Then
Application.EnableEvents = False
Worksheets("Sheet1").Range("date.01") = Target
Worksheets("Sheet2").Range("date.02") = Target
Worksheets("Sheet3").Range("date.03") = Target
Worksheets("Sheet4").Range("date.04") = Target
Worksheets("Sheet5").Range("date.05") = Target
Application.EnableEvents = True
End If
End Sub
I have a spreadsheet that is going to be used in a survey.
How can I make the cells only to return "x" regardless of what the survey taker type in.
For instance, if I write a "w" in the cell, it should turn into an "x".
I have come to a point where I think there is an option when I protect the workbook or sheet. Because I can tell from another spreadsheet (which has this function) that it only works if the workbook is protected.
I tried to google it, but it seems as if I don't know the right keywords to find the answer.
Also, I have found a set of Vba code that I fiddle with, but I'm not sure this is correct. I don't want to attach the code as I don't want to confuse any response here.
Thank you for any help provided.
Put this code in the worksheet module and test it out, when you change a cell in column A (1) it will activate,
Where is the worksheet Module?
Copy and paste the code ,
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("A1,B1,C1,A4,B4,C4")) Is Nothing Then Exit Sub
Application.EnableEvents = 0
If Target <> "" Then Target = "X"
Application.EnableEvents = 1
End Sub
This should work for you (just change the range to the one you need) :
Option Explicit
Sub worksheet_Change(ByVal Target As Range)
On Error GoTo errorbutler 'error handler - important to have this in case your macro does a booboo
Application.Calculation = xlCalculationManual 'turn off automatic calculation to speed up the macro
Application.EnableEvents = False 'turn off events in order to prevent an endless loop
Dim LR, cell As Range 'Declare your variables
Set LR = Range("A1:b3") ' Select range of cells this macro would apply to
For Each cell In Target 'Loops through the cells that user have changed
If Union(cell, LR).Address = LR.Address Then 'Checks if the changed cell is part of your range
cell.Value="x" 'changes the value of that cell to x
End if
Next cell
Errorexit: 'part of error handling procedure
Application.EnableEvents = True 'Turn autocalc back on
Application.Calculation = xlCalculationAutomatic 'turn events back on
Exit Sub
Errorbutler: 'error handling procedure
Debug.Print Err.Number & vbNewLine & Err.Description
Resume Errorexit
End Sub
Oh yes, and this code should be put into the worksheet module - the same way as Dave has shown you
I have made a spreadsheet which a user can enter a postcode and a quantity into 2 cells and I have other cells doing calculations and displaying the results.
I have added some VBA to prevent anyone from deleting rows and columns but I would like to prevent deletion of any cell within a range but also allow a user to make changes to certain cells but also prevent editing of cells with formula in there.
In cell E4, the user can enter a postcode. In E6, the user can enter a quantity. These can be edited but not deleted. E8:E9 and E11:E14 are all drop down lists (validation) which hold data from lists. These can be changed using the drop down but not deleted.
L10:L14, L16, L23:L27, L29, L30:L33 can all have their data edited but not deleted.
What would the VBA for this look like? I guess it would use the Worksheet_Change() event.
Is this what you are trying? Users can edit cell E4 and E6 but they cannot leave it empty. I am also assuming that the cell are not empty before hand.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("E4")) Is Nothing Then
If Len(Trim(Range("E4").Value)) = 0 Then Application.Undo
ElseIf Not Intersect(Target, Range("E6")) Is Nothing Then
If Len(Trim(Range("E6").Value)) = 0 Then Application.Undo
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
FOLLOWUP
Thanks that is what i want to do. What about the other ranges? Is it just a case of loads of IF THEN or can we use a CASE and loop through? – AdRock 2 mins ago
Add/Delete cell addresses from below as applicable.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("E4,E6,E8:E9,E11:E14,L10:L14,L16,L23:L27,L29,L30:L33")) Is Nothing Then
If Len(Trim(Target.Value)) = 0 Then Application.Undo
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
You are partly right but Worksheet_Change() is triggered after the change, so after the deletion.
What I'd do is to have a hidden sheet to store the values entered by the user and then you can check in Worksheet_Change() whether the new value is empty (deleted) or not.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$4" Then
' check the previous value on the hidden sheet here, if changed, then save it, if empty, then restore it
End If
End Sub