Code: Select all
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If ActiveWorkbook.Name <> "Master.xlsm" Then
Exit Sub
End If
' Appends data entry to dynamic validation range on right click
' The validation range must have nothing below
If Not Intersect(Range("E18,E32,E46,E60,E74,E89"), Target) Is Nothing Then
Cancel = True ' Don't perform the standard action
' Your code here; Target is the cell being double-clicked
Dim inter As Range ' a cell with validation, maybe
Dim cell As Range
Dim r As Range ' validation range
Dim sVal As String ' list validation formula
Dim Answer As String
Dim MyNote As String
'If Target.Count > 1 Then Exit Sub '------------------------------------->
'Place your text here
MyNote = "Select Yes to add new comment or No to cancel selection."
'Display MessageBox
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Adding comment")
If Answer = vbNo Then
'Code for No button Press
MsgBox "You have selected No, your selection has been cancelled."
Exit Sub
Else
'Code for Yes button Press
MsgBox "Your new comment has now been added."
End If
On Error Resume Next
Set inter = Intersect(Target, Cells.SpecialCells(xlCellTypeAllValidation))
If inter Is Nothing Then Exit Sub ' ------------------------------------>
For Each cell In inter
If cell.Validation.Type <> xlValidateList Then Exit Sub '------------->
sVal = cell.Validation.Formula1
If Left(sVal, 1) <> "=" Then Exit Sub ' ------------------------------->
Set r = ThisWorkbook.Names(Mid(sVal, 2)).RefersToRange
If r Is Nothing Then Exit Sub ' --------------------------------------->
If IsNumeric(Application.Match(cell.Text, r, 0)) Then Exit Sub '------>
Cancel = True
With r
.Parent.Cells(Me.Rows.Count, .Column).End(xlUp)(2).Value = cell.Text
.Resize(.Count + 1).Sort _
Key1:=r(1), Order1:=xlAscending, _
MatchCase:=False, Orientation:=xlTopToBottom, Header:=xlNo
End With
Next cell
Beep ' the sound of success
End If
End Sub
