Reputation: 53
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
Upvotes: 3
Views: 491
Reputation: 53
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
Upvotes: 2
Reputation: 2875
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
Upvotes: 4