Code Help - MsgBox Does Not Appear/Date and Time Picker

[elenakotanchyan]

Hi All,

I have this lengthy code with certain validations build-in it. Overall, it works well but I want to improve these 2 things:

1) The MsgBox "You are not allowed to paste to range E7:E504" does not display. I am not sure why. It had been working fine before I added the third validation to make sure values in E do not equal to values in F. The code works as I am not allowed to paste in column E but the issue is the absent Message Box.
2) My date time picker shows both date and time. I was wondering if there is a way to remove the time stamp so it only shows the date?

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