elenakotanchyan
New Member
- Joined
- Jul 13, 2023
- Messages
- 10
- Office Version
- 365
- Platform
- Windows
- MacOS
- Web
Hi,
I have this VBA code. The pasting in the range E7:E504 is disabled but the message "You are not allowed to paste to range E7:E504" does not appear. How do I fix it?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngPaste As Range
Dim UndoList As String
Dim rngValidate As Range
Dim cell As Range
' See if any cells in range E6:E504 were updated
Set rngPaste = Intersect(Range("E7:E504"), Target)
' See if any cells in column G were updated
Set rngValidate = Intersect(Columns("G:G"), Target)
' Check for paste action in range E7:E504
If Not rngPaste Is Nothing Then
' Get the undo List to capture the last action performed by user
UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
' See if last action was paste
If Left(UndoList, 5) = "Paste" Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Application.CutCopyMode = False
MsgBox "You are not allowed to paste to range E7:E504"
End If
End If
'Check for validation in column G based on column E
If Not rngValidate Is Nothing Then
For Each cell In rngValidate
If cell.Value <> "" And cell.Offset(0, -2) = "" Then
Application.EnableEvents = False
cell.ClearContents
Application.EnableEvents = True
MsgBox "Please, make sure there is response in column E before providing response in column G ", _
vbOKOnly, "ENTRY ERROR!!!"
End If
Next cell
End If
Set rngCheck = Intersect(Range("E7:E504"), Target)
If Not rngCheck Is Nothing Then
For Each cell In rngCheck
If cell.Value = cell.Offset(o, 1).Value Then
Application.EnableEvents = False
cell.Value = ""
Application.EnableEvents = True
MsgBox "Cells in column E should be different from cells in column F.", -vbOKOnly
End If
Next cell
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myRange As Range
Set myRange = Me.Range("E7:E504")
If Application.Intersect(Target, myRange) Is Nothing Then
Application.CellDragAndDrop = True
Else
Application.CellDragAndDrop = False
End If
With Sheet5.DTPicker1
.Height = 20
.Width = 20
If Not Intersect(Target, Range("H7:H504")) Is Nothing Then
.Visible = True
.Top = Target.Top
.Left = Target.Offset(0, 1).Left
.LinkedCell = Target.Address
Else
.Visible = False
End If
End With
End Sub
I have this VBA code. The pasting in the range E7:E504 is disabled but the message "You are not allowed to paste to range E7:E504" does not appear. How do I fix it?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngPaste As Range
Dim UndoList As String
Dim rngValidate As Range
Dim cell As Range
' See if any cells in range E6:E504 were updated
Set rngPaste = Intersect(Range("E7:E504"), Target)
' See if any cells in column G were updated
Set rngValidate = Intersect(Columns("G:G"), Target)
' Check for paste action in range E7:E504
If Not rngPaste Is Nothing Then
' Get the undo List to capture the last action performed by user
UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
' See if last action was paste
If Left(UndoList, 5) = "Paste" Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Application.CutCopyMode = False
MsgBox "You are not allowed to paste to range E7:E504"
End If
End If
'Check for validation in column G based on column E
If Not rngValidate Is Nothing Then
For Each cell In rngValidate
If cell.Value <> "" And cell.Offset(0, -2) = "" Then
Application.EnableEvents = False
cell.ClearContents
Application.EnableEvents = True
MsgBox "Please, make sure there is response in column E before providing response in column G ", _
vbOKOnly, "ENTRY ERROR!!!"
End If
Next cell
End If
Set rngCheck = Intersect(Range("E7:E504"), Target)
If Not rngCheck Is Nothing Then
For Each cell In rngCheck
If cell.Value = cell.Offset(o, 1).Value Then
Application.EnableEvents = False
cell.Value = ""
Application.EnableEvents = True
MsgBox "Cells in column E should be different from cells in column F.", -vbOKOnly
End If
Next cell
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myRange As Range
Set myRange = Me.Range("E7:E504")
If Application.Intersect(Target, myRange) Is Nothing Then
Application.CellDragAndDrop = True
Else
Application.CellDragAndDrop = False
End If
With Sheet5.DTPicker1
.Height = 20
.Width = 20
If Not Intersect(Target, Range("H7:H504")) Is Nothing Then
.Visible = True
.Top = Target.Top
.Left = Target.Offset(0, 1).Left
.LinkedCell = Target.Address
Else
.Visible = False
End If
End With
End Sub