Assistance with Worksheet_BeforeRightClick

[ABabeNChrist]

I have various worksheet that use name ranges to populate a data validation dropdown. I then use this code below to add new entries to that desired name list. Everything works great. What I’d like to add is for this code to only run on master workbook that is named Master Workbook. That way only the changes can be made on the Master Workbook

Code: Select all

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

' 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,H20,H34,H48,H62,H76,H88,H100,Q14,Q28,Q42,Q56,Q70,Q84,Q96"), Target) Is Nothing Then
        Cancel = True    ' Don't perform the standard action
        ' Your code here; Target is the cell being double-clicked
        'This will allow new data into name ranges

        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 to list, or select No to cancel selection."

        'Display MessageBox
        Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "HomInspect Software Program")

        If Answer = vbNo Then
            'Code for No button Press
            MsgBox "You have selected No, your selection has now been cancelled."
            Exit Sub
        Else
            'Code for Yes button Press
            MsgBox "Your new comment has now been added to list"
        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

I thought of using something like this

Code: Select all

     If ActiveWorkbook.Name <> "Master Workbook.xlsm" Then
        MsgBox ("This feature is not available")
        Exit Sub
    Else
 End If

But could not seem to get it to function correctly

[HansV]

Where did you add this code? It appears to work OK for me if insert it right at the beginning of Worksheet_BeforeRightClick, or immediately below the line

If Not Intersect ...

By the way, you don't need an Else here since there is nothing between it and End If. And the End If should have the same indentation as the line

If ActiveWorkbook.Name ...

[ABabeNChrist]

Hi Hans

Where did you add this code? It appears to work OK for me if insert it right at the beginning of Worksheet_BeforeRightClick, or immediately below the line
If Not Intersect ...

I added line of code just below Worksheet_BeforeRightClick. it didnt seem to work even when starting a new workbook. I'll try again.

By the way, you don't need an Else here since there is nothing between it and End If. And the End If should have the same indentation as the line
If ActiveWorkbook.Name ...

I didnt think the Else was the right choice, I was just trying different things.
And as for the End If, that one slipped by me....I missed it

[ABabeNChrist]

Hi Hans
I"M BACK
It must have been a long day and I must of misspelled the workbook incorrectly, after further review it seems to work just as it was designed. I thank you very must for your assistance.
This is how it appears

Code: Select all

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If ActiveWorkbook.Name <> "Master Workbook.xlsm" Then
        Exit Sub
    End If

[HansV]

Great! I see that you removed the MsgBox line - I was going to suggest that, it would have been a bit much to get that message all the time.

[ABabeNChrist]

I used the message to let me know the code was working correctly, your right it would of been a bit much, lol