Excel VB error Application.Undo & ActiveSheet.Protect

Question

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

Answer 1

OK, I feel sort of stupid now. I figured out the issue. Can’t believe it took this long. The spreadsheet was being protected due to the last half of my code, the part where I have it highlighting the row that it is on. I had to move the Target.Count part to the top of that sub heading. So everything before the Private Sub Worksheet_SelectionChange(ByVal Target As Range) hasn’t changed, but after that I had to modify the location on where it checks how many cells are selected, to prevent the spreadsheet from being protected. Apparently when you drag down, it is sort of like selecting cells individually and all of them at the same time. Which is why when I pasted data in the spreadsheet the code worked without erring, because it would just read the SelectionChange category once, but if I dragged down it will read this section each time you drag down. I didn’t know that before, but I guess that must be how it works.

So I just modified the code to look like this in the SelectionChange part and it now works. Also thanks for everyone who left comments and suggestions for me.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Cells.CountLarge = 1 Then

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.'''


'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


ActiveSheet.Protect
Application.EnableEvents = True

End If

End Sub