greenhillchris
New Member
- Joined
- Mar 5, 2022
- Messages
- 18
- Office Version
- 365
Hi there,
I have a worksheet that contains data vaildation via drop down menus and certain format that dates and times should be entered into cells.
I want to proetect these cells when copy and pasting from other cells and only allow the pasting if the data pasted meets the data vaildation of the cells but I also want to allow an undo function that undoes the last action taken by the user before running the macro.
I have found the below code which works how I want it to however the undo functon does not work, I have tried putting the Application.Undo code in differnet places of the code and it just closes my workbook.
Any ideas where I am going wrong with this code?
I have a worksheet that contains data vaildation via drop down menus and certain format that dates and times should be entered into cells.
I want to proetect these cells when copy and pasting from other cells and only allow the pasting if the data pasted meets the data vaildation of the cells but I also want to allow an undo function that undoes the last action taken by the user before running the macro.
I have found the below code which works how I want it to however the undo functon does not work, I have tried putting the Application.Undo code in differnet places of the code and it just closes my workbook.
Any ideas where I am going wrong with this code?
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xValue As String
Dim xCheck1 As String
Dim xCheck2 As String
Dim xRg As Range
Dim xArrCheck1() As String
Dim xArrCheck2() As String
Dim xArrValue()
Dim xCount, xJ As Integer
Dim xBol As Boolean
' If Target.Count > 1 Then
' Exit Sub
' End If
xCount = Target.Count
ReDim xArrCheck1(1 To xCount)
ReDim xArrCheck2(1 To xCount)
ReDim xArrValue(1 To xCount)
Application.EnableEvents = False
On Error Resume Next
xJ = 1
For Each xRg In Target
xArrValue(xJ) = xRg.Value
xArrCheck1(xJ) = xRg.Validation.InCellDropdown
xJ = xJ + 1
Next
Application.Undo
xJ = 1
For Each xRg In Target
xArrCheck2(xJ) = xRg.Validation.InCellDropdown
xJ = xJ + 1
Next
xBol = False
For xJ = 1 To xCount
If xArrCheck2(xJ) <> xArrCheck1(xJ) Then
xBol = True
Exit For
End If
Next
If xBol Then
MsgBox "The selected cells containg data validation drop-down lists, no pasting allowed."
Else
xJ = 1
For Each xRg In Target
xRg.Value = xArrValue(xJ)
xJ = xJ + 1
Next
End If
Application.EnableEvents = True
End Sub