Making changes to a Dynamic name list using code

[ABabeNChrist]

Hi HansV
I liked the thought of adding a message box with the yes no option. So I tried to add one, but even when I select No it still insert new entry.
I also added Sheet protection

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


  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    '------------------------------------->
 ActiveSheet.Unprotect Password:=""
     'Place your text here
    MyNote = "Do you wish to save"

    'Display MessageBox
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Adding Comment to list")

    If Answer = vbNo Then
        'Code for No button Press
        MsgBox "You pressed NO! Cancel Comment"
    Else
        'Code for Yes button Press
        MsgBox "Comment has 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
 ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, Password:=""
End Sub

[HansV]

That's because you don't really use the result of the message box. Try

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

  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

  Cancel = True
  ActiveSheet.Unprotect Password:=""

  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  '------>

    If MsgBox("Do you wish to add this entry to the list?", vbQuestion + vbYesNo, _
        "Adding Comment to list") = vbYes Then
      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
    End If
  Next cell

  Beep    ' the sound of success
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, Password:=""
End Sub

[ABabeNChrist]

Thank You HansV
Most greatly appreciated

[ABabeNChrist]

I have removed my merged cells and tried modifying the code to function for a single cell. It appears like its working but, it doesn’t add new entry to list.

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("B9,B11,B12"), 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 HomInspect Report name ranges

    Dim cell        As Range    ' a cell with validation, maybe
    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 IF YOU WISH 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 BEEN CANCELED"
        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 cell = Intersect(Target, Cells.SpecialCells(xlCellTypeAllValidation))
    If cell Is Nothing Then Exit Sub    ' ------------------------------------->
    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(Target.Text, r, 0)) Then Exit Sub  '-------->

    Cancel = True
    With r
        .Parent.Cells(Me.Rows.Count, .Column).End(xlUp)(2).Value = Target.Text
        .Resize(.Count + 1).Sort _
                Key1:=r(1), Order1:=xlAscending, _
                MatchCase:=False, Orientation:=xlTopToBottom, Header:=xlNo
   End With
        Beep    ' the sound of success
   End If
End Sub

[HansV]

I'd have to see (a copy of) the workbook.

Could you try harder to indent your code correctly? The indenting at the end of the macro makes it more difficult to understand how it works.

[HansV]

Another point: I don't like the ALL CAPS text in the message boxes. ALL CAPS text is harder to read, and it gives the impression you're shouting at the user.

[ABabeNChrist]

Hi Hans
I’m sorry for my code indent, I’m trying. I don’t know the rule of thumb; I see so many different ways that people do it, so it gets confusing sometimes.
Here’s a sample of a no merged cell Workbook I’m working on.

Sample.xlsb

update: regarding your last message, I see what you mean I agree

[HansV]

RefersToRange won't work with dynamic defined names. You'll have to use non-dynamic names and change their definition as the list grows.

[mbarron]

Hi Hans
I’m sorry for my code indent, I’m trying. I don’t know the rule of thumb; I see so many different ways that people do it, so it gets confusing sometimes.

You can try using Smart Indenter to help get thing lined up. V3.5 will work with Office 2007

[ABabeNChrist]

Thanks Hans and mbarron
I made changes to the code, and indented code (using Smart Indent)
As you may know I’m new with writing code and I was having a hard time with indenting my code correctly, I thank you so much for this freeware. It works great and is so simple to use, it will be a great tool for me to learn with.
I have attached a new updated Sample Workbook.

Sample.xlsb

[HansV]

As I mentioned higher up in this thread, the code fails on the line

Set r = ThisWorkbook.Names(Mid(sVal, 2)).RefersToRange

The Data Validation for B11 and B12 uses dynamic named ranges, and RefersToRange doesn't work with dynamic ranges.

To get around this, you'll have to use another method to specify the source range for the list. For example:

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
    Dim cell As Range
    Dim Answer As String
    Dim MyNote As String
    Dim c As Long
    If Not Intersect(Range("B11,B12"), Target) Is Nothing Then
        Cancel = True    ' Don't perform the standard action
        'This will allow new data into HomInspect Report name ranges

        '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
        End If

        'Code for Yes button Press
        For Each cell In Intersect(Range("B11,B12"), Target)
            ' Determine column of source list
            Select Case cell.Row
                Case 11
                    c = 3
                Case 12
                    c = 4
            End Select
            With Worksheets("Comments")
                ' Make sure value is new
                If Not .Columns(c).Find(What:=cell.Value, LookAt:=xlWhole, MatchCase:=False) Is Nothing Then
                    Exit Sub
                End If
                ' Add the value
                .Cells(.Rows.Count, c).End(xlUp).Offset(1, 0).Value = cell.Value
                ' Sort the list
                .Columns(c).Sort Key1:=.Cells(1, c), Header:=xlYes
            End With
        Next cell
        MsgBox "Your new comment has now been added to list"
    End If
End Sub

I moved the code around a bit to make it more logical.

[ABabeNChrist]

Hi Hans
I understand mostly what you are saying, but it seems to function correctly with no errors on my side why is that?

[ABabeNChrist]

Hi Hans
I applied your code and it works great.
I understand most of the code you have given me.
Am I correct when assuming this?

Code: Select all

          Select Case cell.Row
                Case 22 	‘This refers to cell 22 location on active sheet
                    c = 8	‘This refers to column 8 located on comment sheet

I then make necessary change to each sheet to reflect as such

[HansV]

The line

Select Case cell.Row

means that you look at the row number of the cell being right-clicked on the active sheet; lines such as

Case 11

look at specific row numbers. Lines such as

c = 3

specify the number of the column on the Comments sheet that contains the source list for the validation of cell.

[ABabeNChrist]

Thank you Hans