Forcing Paste Values when copying or cutting to avoid formatting or data validation changes (including external data)

Question

I'm building a workbook for others to enter data, but I need them not to interfere with the formats or validations. I looked a lot on the web and came up with a good way of doing it (IMHO). I'm using a Worksheet_Change sub that checks if input data was copied, cut or directly written in the cell. The problem I have is that it works great when it's copied, but when it's cut and reaches the "exit sub" part, it goes back to the beginning of the procedure doing it all over. I guess the Worksheet_Change event triggers again when I exit the sub, but I don't understand why this happens.

This is my main problem. A second problem is that if the text was written (not copied or cut) I want to redo the writing (ctrl Y on windows or cmd Y on mac), but I have a Mac and don't know how to refer to the "command" button.

Here's the code. Notes are in spanish as I'm from Argentina. Thanks in advance for your help!

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range
    Dim CeldasNoValidadas As String
    
    On Error GoTo Whoa

    CeldasNoValidadas = " "
        
    Application.EnableEvents = False
    
    Application.Undo
    
    'Si se puso Copiar, pega valores
    If Application.CutCopyMode = xlCopy Then
        Target.PasteSpecial Paste:=xlPasteValues
    Else
        'Si se puso cortar avisa que no se puede y sale.
        If Application.CutCopyMode = xlCut Then
            MsgBox "No se puede pegar contenido que se haya cortado. Copie el contenido para pegarlo en esta celda.", , """Cortar"" no esta permitido"
            Application.EnableEvents = True
            Exit Sub
        Else
            'Si no puso cortar ni copiar, repite la accion que se deshizo.
            Application.SendKeys ("^y")
        End If
    End If

    'Chequea que cada celda cumpla con la validacion
    For Each aCell In Target.Cells
        If Not aCell.Validation.Value Then
            'Si la celda no es valida la borra y la suma a la lista de celdas no validas
            CeldasNoValidadas = CeldasNoValidadas & ", " & aCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
            aCell.ClearContents
        End If
    Next

    'Si alguna celda no cumple la validacion, muestra un mensaje con la lista de celdas no validas
    If Len(CeldasNoValidadas) > 1 Then
       MsgBox "Las siguientes celdas no tienen contenido valido y fueron borradas: " & Right(CeldasNoValidadas, Len(CeldasNoValidadas) - 3), , "Celdas no validas"
    End If

        Application.EnableEvents = True
        Exit Sub

Letscontinue:
        Application.EnableEvents = True
        Exit Sub
Whoa:
        MsgBox Err.Description
        Resume Letscontinue


End Sub

From your description, can't you lock the cells that you do not want people to mess with and protect the worksheet? — Raymond Wu, Jul 04 '21 at 01:22
I agree with Raymond that it would probably be easier to lock every cell you don’t want changed. However if you want to keep using your idea, you should set some breakpoints to figure out where it skips to `Whoa` — Marcucciboy2, Jul 04 '21 at 04:08

Super Symmetry · Accepted Answer · 2021-07-04T06:32:29.190

You can use a combination of SelectionChange and Change event handlers to simplify your code and deal with both problems like this:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim aCell As Range
    Dim CeldasNoValidadas As String

    On Error GoTo Whoa

    CeldasNoValidadas = " "

    Application.EnableEvents = False

    'Si se puso Copiar, pega valores
    If Application.CutCopyMode = xlCopy Then
        Application.Undo
        Target.PasteSpecial Paste:=xlPasteValues
    End If

    'Chequea que cada celda cumpla con la validacion
    For Each aCell In Target.Cells
        If Not aCell.Validation.Value Then
            'Si la celda no es valida la borra y la suma a la lista de celdas no validas
            CeldasNoValidadas = CeldasNoValidadas & ", " & aCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
            aCell.ClearContents
        End If
    Next

    'Si alguna celda no cumple la validacion, muestra un mensaje con la lista de celdas no validas
    If Len(CeldasNoValidadas) > 1 Then
       MsgBox "Las siguientes celdas no tienen contenido valido y fueron borradas: " & Right(CeldasNoValidadas, Len(CeldasNoValidadas) - 3), , "Celdas no validas"
    End If

Letscontinue:
        Application.EnableEvents = True
        Exit Sub
Whoa:
        MsgBox Err.Description
        Resume Letscontinue


End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Application.CutCopyMode = xlCut Then
        Application.CutCopyMode = False
        MsgBox "No se puede pegar contenido que se haya cortado. Copie el contenido para pegarlo en esta celda.", , """Cortar"" no esta permitido"
    End If
End Sub

This way you undo if and only if the user is copying cells. You therefore, never need to redo (i.e. no need to SendKeys which should be avoided as much as possible)

Note 1: Why does cut/paste trigger the Change event twice? Under the hood a cut/paste action is a combination of a copy/paste and a delete actions, both of which trigger the Change event handler.

Note 2: The above solution does not prevent users from copying contents from other applications (e.g. word and internet browser). It also doesn't prevent them from autofilling. You can check the "undo" list to work out the last action (have a look at this). If the last action was a paste and CutCopyMode is false, then chances are the contents were copied from another application. To deal with such situations you can do the following (this is by no means exhaustive):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim aCell As Range
    Dim CeldasNoValidadas As String
    Dim undoAction As String

    On Error GoTo Whoa

    CeldasNoValidadas = " "

    Application.EnableEvents = False

    'Si se puso Copiar, pega valores
    If Application.CutCopyMode = xlCopy Then
        Application.Undo
        Target.PasteSpecial Paste:=xlPasteValues
    Else
        '* Get the last action from the undo list
        undoAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
        
        '* A paste here means contents were copied from outside the application
        If Left(undoAction, 5) = "Paste" Then
            '* If not pasting images (from the internet - html) then remove formatting
            '* Remove the condition if you do not want to allow pasting images from the internet
            If MsgBox("Are you pasting an image?", vbYesNo + vbDefaultButton2) <> vbYes Then
                Application.Undo
                Me.PasteSpecial Format:="HTML", DisplayAsIcon:=False, Link:=False, NoHTMLFormatting:=True
            End If
        ElseIf undoAction = "Auto Fill" Then
            Application.Undo
            MsgBox "Auto fill not allowed, please try copying"
        End If
    End If

    'Chequea que cada celda cumpla con la validacion
    For Each aCell In Target.Cells
        If Not aCell.Validation.Value Then
            'Si la celda no es valida la borra y la suma a la lista de celdas no validas
            CeldasNoValidadas = CeldasNoValidadas & ", " & aCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
            aCell.ClearContents
        End If
    Next

    'Si alguna celda no cumple la validacion, muestra un mensaje con la lista de celdas no validas
    If Len(CeldasNoValidadas) > 1 Then
       MsgBox "Las siguientes celdas no tienen contenido valido y fueron borradas: " & Right(CeldasNoValidadas, Len(CeldasNoValidadas) - 3), , "Celdas no validas"
    End If

Letscontinue:
        Application.EnableEvents = True
        Exit Sub
Whoa:
        MsgBox Err.Description
        Resume Letscontinue


End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Application.CutCopyMode = xlCut Then
        Application.CutCopyMode = False
        MsgBox "No se puede pegar contenido que se haya cortado. Copie el contenido para pegarlo en esta celda.", , """Cortar"" no esta permitido"
    End If
End Sub

Thanks a lot for your answer. It introduced me to other worksheet events I hadn't considered for my problem, and it guided me to other paths for improving the code. I'll add my modifications to the answer to help others. — Rochi, Jul 04 '21 at 18:55

score 1 · Answer 2 · answered Jul 05 '21 at 16:55

Here's the solution I came up with:

Following @Super Symmetry's advice, I approached my problem differently, using some of his solutions and adding other code to fulfill my requirements. What I wanted was to avoid overwriting the format or validation of the cells by a paste operation (it's a protected worksheet, but lots of cells are available for data entry).

I had to consider 4 situations for user behavior before pasting: 1- User copies data from any excel sheet. 2- User cuts data from any excel sheet. 3- User copy or cuts data from another application. This will happen a lot, since the sheet asks for information that users will access from emails, word documents, etc., like names, identification numbers and email addresses. 4- After this, I needed to avoid text not following the validation rules for each cell.

1: This was addressed in my original code:

    'If data was copied, undo and paste values
    If Application.CutCopyMode = xlCopy Then
        Application.Undo
        Target.PasteSpecial Paste:=xlPasteValues

2: I followed @Super Symmetry suggestions of having a SelectionChange event handler, but I added an Activate event handler just in case someone cuts from another sheet and pastes in the active cell without selecting another cell (in which case SelectionChange would not run).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        
    'If data was cut, it displays a message saying pasting cut data is not allowed
    If Application.CutCopyMode = xlCut Then
        Application.CutCopyMode = False
        MsgBox "No se puede pegar en esta pagina contenido que se haya cortado. Copie el contenido para pegarlo en esta pagina.", , """Cortar"" no esta permitido"
        Exit Sub
    End If

End Sub

The Private Sub Worksheet_Activate() code is the same as the SelectionChange code above.

3: This one was tricky, since data copied or cut in external applications overwrites the format and data validation. I need the code to work on Mac and Windows, and Mac doesn't accept the Undo Lists. Since I gave all entry cells a validation rule, I assigned the data validation type to a variable, and if I get an error (meaning the cell has no validation), I undo and paste values. You'll notice I don't use Paste:=xlPasteValues. I tried that but it didn't work when copying from the web. Therefore, I found that pasting as html with no format works in all the instances I tried it.

        'If cell doesn't have validation, undo and paste values.
    For Each aCell In Target.Cells
        On Error Resume Next
        Validado = aCell.Validation.Type
        If Err.Number = 1004 Then
            Application.Undo
            ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
            Err.Clear
        End If
        On Error GoTo Whoa
    Next

4: I looped through all the cells and checked if each entry follows the validation rules of that cell. If not, I delete the cell's contents and I build a string with the address of all the cells. After all the checking a MsgBox tells the user which cells didn't follow validation rules and were deleted.

    For Each aCell In Target.Cells
        If Not aCell.Validation.Value Then
            'Si la celda no es valida la borra y la suma a la lista de celdas no validas
            CeldasNoValidadas = CeldasNoValidadas & ", " & aCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
            aCell.ClearContents
        End If
    Next

    'Si alguna celda no cumple la validacion, muestra un mensaje con la lista de celdas no validas
    If Len(CeldasNoValidadas) > 1 Then
       MsgBox "Las siguientes celdas no tienen contenido valido y fueron borradas: " & Right(CeldasNoValidadas, Len(CeldasNoValidadas) - 3), , "Celdas no validas"
    End If

Here is the whole code, so you can have a better understanding of the complete solution:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range
    Dim CeldasNoValidadas As String
    Dim Validado As Integer
    
    On Error GoTo Whoa

    CeldasNoValidadas = " "
        
    Application.EnableEvents = False
    
    'Si se puso Copiar, pega valores
    If Application.CutCopyMode = xlCopy Then
        Application.Undo
        Target.PasteSpecial Paste:=xlPasteValues
    End If
    
    'Chequea que cada celda cumpla con la validacion
    For Each aCell In Target.Cells
        'Si se cambio la validacion porque se pego desde otra aplicacion, deshace y pega valores.
        On Error Resume Next
        Validado = aCell.Validation.Type
        If Err.Number = 1004 Then
            Application.Undo
            ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
            Err.Clear
        End If
        On Error GoTo Whoa
        'Si la celda esta en una columna de precios, y tiene mas de 2 decimales, lo reduce a 2 decimales.
        Select Case ActiveCell.Column
            Case 6, 7, 8
                If Not IsEmpty(aCell) = True Then
                    aCell.Value = Round(aCell.Value, 2)
                End If
        End Select
        If Not aCell.Validation.Value Then
            'Si la celda no es valida la borra y la suma a la lista de celdas no validas
            CeldasNoValidadas = CeldasNoValidadas & ", " & aCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
            aCell.ClearContents
        End If
    Next

    'Si alguna celda no cumple la validacion, muestra un mensaje con la lista de celdas no validas
    If Len(CeldasNoValidadas) > 1 Then
       MsgBox "Las siguientes celdas no tienen contenido valido y fueron borradas: " & Right(CeldasNoValidadas, Len(CeldasNoValidadas) - 3), , "Celdas no validas"
    End If

        Application.EnableEvents = True
        Exit Sub

Letscontinue:
        Application.EnableEvents = True
        Exit Sub
Whoa:
        MsgBox Err.Description
        Resume Letscontinue


End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        
    'Si se puso cortar avisa que no se puede y sale.
    If Application.CutCopyMode = xlCut Then
        Application.CutCopyMode = False
        MsgBox "No se puede pegar en esta pagina contenido que se haya cortado. Copie el contenido para pegarlo en esta pagina.", , """Cortar"" no esta permitido"
        Exit Sub
    End If

End Sub

Private Sub Worksheet_Activate()

    'Si se puso cortar avisa que no se puede y sale.
    If Application.CutCopyMode = xlCut Then
        Application.CutCopyMode = False
        MsgBox "No se puede pegar en esta pagina contenido que se haya cortado. Copie el contenido para pegarlo en esta pagina.", , """Cortar"" no esta permitido"
        Exit Sub
    End If

End Sub

Great catch on `Worksheet_Activate`. Thanks for sharing your answer +1. As you can tell, it is very difficult to exhaust all possibilities. The way I dealt with this problem in the past was to reset formats/validations every time certain ranges got changed. I did that either by a list of formats/validations or by having clone ranges that I could simply copy formats/validations of and paste them on the changed cells. Just another option you can think about :) — Super Symmetry, Jul 05 '21 at 17:52

Forcing Paste Values when copying or cutting to avoid formatting or data validation changes (including external data)

2 Answers2