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!
Related
I have to unlock a specific range (D6:BC116) in a excel sheet. It should be able for other people editing this specific area. So it should be unlocked for them.
At first I manually protect the whole sheet without any code. And after that I want to unprotect the specific area for editing. But something always goes wrong. I have these two codes. The first code has the hidden property it only hides empty cells. The other code I am trying to unprotect specific area I want to edit after protecting the whole sheet.
I am not really sure if the problem is in the first code because of the hidden property? And I am not sure if they are in a relation?
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Range("B6:B112")
If cell.Value <> "" Then
cell.EntireRow.Hidden = False
Else
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
Sub UnlockCells()
Worksheets("Sheet1").Range("D6:BC116").Locked = False
Worksheets("Sheet1").Protect
End Sub
And when I execute this I always get "Index out of range"
Thanks!
I think you need to unprotect before unlocking.
Like this:
With Worksheets("Sheet1")
.Unprotect "MyLongAndSecurePassword"
.Range("D6:BC116").Locked = False
.Protect
End with
Concerning the first part of the code - make sure that you use a variable, which is not named cell, because cell is used by the VBEditor. Name your variable rngCell, myCell or anything else but cell. And declare it like this: Dim rngCell as Range.
Last point - lock your worksheet and try to hide and unhide manually the rows. Is it possible? If not, you know the reason for the error.
Edit:
To check whether the sheet is protected, try this in the Worksheet_Change:
Private Sub Worksheet_Change(ByVal Target As Range)
If Worksheets("Sheet1").ProtectContents Then Exit Sub
For Each cell In Range("B6:B112")
If cell.Value <> "" Then
cell.EntireRow.Hidden = False
Else
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
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).
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 an Excel like shown below which is a sharedExcel.
Now i should not allow paste option for the rows which have backcolour as GRAY(These are not fixed at runtime any row may get GRAY colour). As it sharedExcel and i can't use the Lock property. Any help wouls be appreciated greatly.
Using a color as a property that is used to check true / false is bad behaviour.
You can get around this by for example adding a column (hidden if needed) with 0 / 1 or TRUE / FALSE which you make accessible by for example a combobox (then you can still adapt the color into gray by clicking this cbb box).
The you can check on a dynamically composed range via a Sheet event on_Change.
The basic syntax for the sheet event:
Private Sub Worksheet_Change(ByVal Target As Range)
'Set range dynamically instead of this hard coded example
If Not Intersect(Target, Thisworkbook.Sheets(1).Range("A1:A10")) Is Nothing Then
'Do something
End If
End Sub
After spending some time on this problem i have coded following lines. It work's fine. Here i have taken another spreadsheet called PasteSheet for coding purpose but i am not showing it to user at any moment.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode Then
SelectedRow = ActiveCell.Row
With Sheets("PasteSheet")
.Activate
.Range("A1").PasteSpecial xlPasteValues
CR = Selection.Rows.Count
End With
Worksheets("ActualSheet").Activate
For k = SelectedRow To (SelectedRow + CR)
If Worksheets("ActualSheet").Cells(k, 30).Interior.Color = RGB(215, 215, 215) Then
Application.EnableEvents = False
MsgBox "Pasting is not allowed here!"
'Clearing data in PasteSheet
Worksheets("PasteSheet").Cells.ClearContents
Worksheets("ActualSheet").Activate
Application.EnableEvents = True
Exit Sub
End If
Next
End If
End Sub