Curious if anyone had a solution to this. Here is my code below and I thought it was working perfectly. We were using it for a long time and someone else pointed out to me something they do all the time, which causes a script error.
What this code does is it prevents someone from updating more than one cell at a time. If someone copies a large chunk of data, where it takes up more than one row or column when pasted to in Excel, such as coping an email and pasting it into the spreadsheet, a popup alert is received saying not to change more than one cell at a time and then it will undo the paste. This part works great.
What someone is doing, which is causing an error, is they would select a cell and where it has that square on the bottom right of the cell that you can click and drag on to fill down or over, they would select that and fill down. If filling in just one cell down, there isn’t an issue. The issue is when they do this to two or more cells, that is when the error happens. More specifically on the line that says Application.Undo
.
So the issue really isn’t with the line Application.Undo
, it is actually with the spreadsheet being locked. If I was to rem out the lines that say ActiveSheet.Unprotect
and ActiveSheet.Protect
then the code works fine. However, I do want it to be protected. There is a lot more code then what I have here, but this is just a snippet of it and I do have the cells correctly formatted so the right ones are locked and the others aren’t. You should be able to take the code and paste it in a new spreadsheet and it will work, so you can see what I am talking about, however, make sure you unlock some cells first so they can be edited. Once you do that to see the error, rem out the Protect/unprotect lines to try again and the code will work without any issues.
Please let me know if someone has a solution to this so I can still keep the spreadsheet protected and thanks for any help!
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
ActiveSheet.Unprotect
Dim vClear As Variant
Dim vData As Variant
Dim lFirstRow As Long
Dim lLastRow As Long
'This prevents more than one cell from being changed at once.
'If more than one cell is changed then validation checks will not work.
If Target.Cells.Count > 1 Then
vData = Target.Formula
For Each vClear In vData
If vClear <> "" Then 'If data is only deleted then more than one cell can be changed.
MsgBox "Change only one cell at a time", , "Too Many Changes!"
Application.Undo
Exit For
Else
'If data is deleted this will check to see what columns are being deleted.
'Deleting certain columns will also allow for the automatic deletion of other columns not selected.
If vClear = "" Then
'If the target includes columns D, it will also clear columns M & N.
If Not Intersect(Target, Columns("D")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column M & N.
ActiveSheet.Range(Cells(lFirstRow, 13), Cells(lLastRow, 13)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 14), Cells(lLastRow, 14)).ClearContents
End If
'If the target includes columns G, it will also clear columns I & K & N.
If Not Intersect(Target, Columns("G")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column I & K & N.
ActiveSheet.Range(Cells(lFirstRow, 9), Cells(lLastRow, 9)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 11), Cells(lLastRow, 11)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 14), Cells(lLastRow, 14)).ClearContents
End If
'If the target includes columns H, it will also clear columns I & K.
If Not Intersect(Target, Columns("H")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column I & K.
ActiveSheet.Range(Cells(lFirstRow, 9), Cells(lLastRow, 9)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 11), Cells(lLastRow, 11)).ClearContents
End If
'If the target includes column J, it will also clear column K.
If Not Intersect(Target, Columns("J")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column K.
ActiveSheet.Range(Cells(lFirstRow, 11), Cells(lLastRow, 11)).ClearContents
End If
End If
End If
Next
End If
ActiveSheet.Protect
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
ActiveSheet.Unprotect
Dim iFirstCol As Integer
Dim iLastCol As Integer
Dim iFirstRow As Integer
Dim iLastRow As Integer
Dim iColor As Integer
'''Only adjust the below numbers to fit your desired results.'''
iFirstCol = 1 'Change this number to the number of the first column that needs to be highlighted. Column A = 1.
iLastCol = 15 'Change this number to the number of the last column that needs to be highlighted. Column A = 1.
iFirstRow = 7 'Change this number to the number of the first row that needs to be highlighted.
iLastRow = 500 'Change this number to the number of the last row that needs to be highlighted.
iColor = 20 'Change this number to use a different highlight color.
'''End of changes, do not change anything else.'''
If Target.Count = 1 Then
'The row highlight will only be applied if the selected range is within this if statement criteria.
If Target.Row > iFirstRow - 1 And Target.Row < iLastRow + 1 And Target.Column > iFirstCol - 1 And Target.Column < iLastCol + 1 Then
'Resets the color within the full range when cell selection changed.
ActiveSheet.Range(ActiveSheet.Cells(iFirstRow, iFirstCol), ActiveSheet.Cells(iLastRow, iLastCol)).Interior.Color = xlNone
'Applies the colors to the row.
For counter = iFirstCol To iLastCol
With ActiveSheet.Cells(Target.Row, iFirstCol).Interior
.ColorIndex = iColor
.Pattern = xlSolid
End With
iFirstCol = iFirstCol + 1
Next counter
End If
End If
ActiveSheet.Protect
Application.EnableEvents = True
End Sub