Multiple Data Validations on one sheet that trigger different actions

thoerl

New Member
Joined
Jun 12, 2024
Messages
2
Office Version
  1. 365
Platform
  1. Windows
I have a sheet that has a drop down validation list for one cell that has a sheet macro (VBA) to fill in certain cells in the sheet based on selection. In another cell, I have a drop down validation list that I need to allow 2 items to be selected, and also allow the user to deselect an item if it was selected in error. First issue is having multiple procedures on the Sheet in VBA. if I do this, it affects other procedures called by the Macro. Second issue is that I can either select multiple items in the second cell from its list, and allow deselection, but it won't limit to 2 items. OR I can have the second cell allow selecting 2 items, but I can't remove a selection that was made in error. How can I achieve the intended goal?
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Hi thoerl. Let's deal with one item at a time. It would help a lot if you could post some code and a visual of your worksheet if possible. You know about wrapping the code? You know about using the xl2bb Add-in to post your worksheet?

In the sheet events, each range can be parsed from others easily. Do you have named ranges for the drop down cells?

Jeff
 
Upvote 0
This is the Worksheet code for branching based on the selection in the first drop down. F8 has the drop down, and the validation list is in a named range on another sheet.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  ' Call macros to create form based on selection
  'Dim WTPChoice As Range
  If Not Intersect(Target, Range("F8")) Is Nothing Then
    If InStr(1, Range("F8"), "New Client") = 1 Then
      Call CMType1m
    End If
    If InStr(1, Range("F8"), "New Item") = 1 Then
      Call CMType2m
    End If
    If InStr(1, Range("F8"), "Supplement to previous Item") = 1 Then
      Call CMType3m
    End If
    If InStr(1, Range("F8"), "Declined Client") = 1 Then
      Call CMType4m
    End If
    If InStr(1, Range("F8"), "Special Item") = 1 Then
      Call CMType5m
    End If
  End If
  
End Sub

This is the code for the section drop-down, but developed in another workbook to test the functionality. If I add it to the code above, I get an error when it calls the procedure listed. This version allows only 2 selections, and also does not allow removal of a selection that was selected in error. Similarly, this has the drop-down validation in B2, and also calls a named range for the validation list.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    'https://stackoverflow.com/questions/66470575/restrict-only-two-selections-in-a-multi-selection-drop-down-in-excel
    'I added the unprotect and protect sheet for it to work with a protected sheet, otherwise only one enter shows
    Const MaxEntries = 2
    
    Dim Oldvalue As String
    Dim Newvalue As String
   
    If Target.Address <> "$B$2" Then GoTo Exitsub
    On Error GoTo Exitsub
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then GoTo Exitsub
    If Target.Value = "" Then GoTo Exitsub
        
    Application.EnableEvents = False
    
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
    If Oldvalue = "" Then
        Target.Value = Newvalue
    ElseIf InStr(Oldvalue, Newvalue) = 0 And countCharsInStr(Oldvalue, vbNewLine) + 1 < MaxEntries Then
        Target.Value = Oldvalue & vbNewLine & Newvalue
    Else
        Target.Value = Oldvalue
    End If
    
    Rows("9").EntireRow.Hidden = InStr(Target.Value, "5") > 0
    
Exitsub:
    Application.EnableEvents = True
End Sub

Public Function countCharsInStr(s As String, c As String) As Long
    countCharsInStr = (Len(s) - Len(Replace(s, c, ""))) / Len(c)
End Function


Finally this is the code similar to above, but allows for removal of a selection made in error, but does not limit the number of selections.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To allow multiple selections in a Drop-Down List in Excel (without repetition)
'  Edited to allow deselection of item (courtesy of Jamie Counsell)
' 240607 Tom Hoerl
' Add limit to 2 items
' Change delimiter to line feed
Application.EnableEvents = True
On Error GoTo Exitsub
Dim Delimitertype As String
Const MaxEntries = 2
Delimitertype = vbCrLf
If Target.Address = "$B$2" Then
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
        GoTo Exitsub
    ElseIf Target.Value = "" Then
        GoTo Exitsub
    Else
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        Target.Value = Newvalue
        
       If Oldvalue <> "" Then
            If Newvalue <> "" Then
                If InStr(1, Oldvalue, Delimitertype & Newvalue & Delimitertype) > 0 Then
                    'Oldvalue = Replace(Oldvalue, Newvalue & Delimitertype, "") ' If it's in the middle with delimiter
                    Target.Value = Oldvalue
                    GoTo jumpOut
                End If

                If Left(Oldvalue, Len(Newvalue & Delimitertype)) = Newvalue & Delimitertype Then
                    Oldvalue = Replace(Oldvalue, Newvalue & Delimitertype, "") ' If it's at the start with delimiter
                    Target.Value = Oldvalue
                    GoTo jumpOut
                End If
                If Right(Oldvalue, Len(Delimitertype & Newvalue)) = Delimitertype & Newvalue Then
                    Oldvalue = Left(Oldvalue, Len(Oldvalue) - Len(Delimitertype & Newvalue)) ' If it's at the end with a delimiter in front of it
                    Target.Value = Oldvalue
                    GoTo jumpOut
                End If
                If Oldvalue = Newvalue Then ' If it is the only item in string
                    Oldvalue = ""
                    Target.Value = Oldvalue
                    GoTo jumpOut
                End If
                Target.Value = Oldvalue & Delimitertype & Newvalue
            End If
jumpOut:
        End If
    End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub


I've tried a few different things to combine the limiting of selection to 2 items, and also allow removing invalid selections, but haven't figured out the correct way to do it. I've also searched for every combination I could think of to get what I needed, but came up empty handed.
 
Upvote 0

Forum statistics

Threads
1,223,864
Messages
6,175,056
Members
452,607
Latest member
OoM_JaN

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top