none
Make fields multi select RRS feed

  • Question

  • I have an excel file I'm working on.  I need to make all from column F except cell 1 multi select.   There are a few other I will need to do this to also but I cannot make all drop downs multi select as I will have some that need to remain single select.  I found this code of it only let me make one cell this way.  How can I make this work on multiple columns with all of their cell? 

    Private Sub Worksheet_Change(ByVal Target As Range)

    'Code by Sumit Bansal from https://trumpexcel.com
    ' To Select Multiple Items from a Drop Down List in Excel

    Dim Oldvalue As String
    Dim Newvalue As String

    On Error GoTo Exitsub
    If Target.Address = "$K$2" Then
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
        GoTo Exitsub
        Else: If Target.Value = "" Then GoTo Exitsub Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else
                Target.Value = Oldvalue & ", " & Newvalue
            End If
        End If
    End If
    Application.EnableEvents = True
    Exitsub:
    Application.EnableEvents = True
    End Sub

    Friday, May 5, 2017 6:08 PM

All replies

  • Replace all of your code with the following code. The code can all go in the worksheets module.

    Note the use of Select Case in lieu of If statements (even though there is only one case) makes it easy to edit the Case line with the list of MultiSelect DropDowns.

    Private Sub Worksheet_Change(ByVal Target As Range)

        Select Case Target.Address
            'Edit following line with the list of addresses for your multi select DropDowns
            'Note the absolute addressing with the $ signs and the separating commas.
            Case "$A$2", "$C$2", "$E$2", "$G$2", "$I$2"
                Call MultiSelect(Target)
        End Select
       
     End Sub


    Sub MultiSelect(rngTarg As Range)
        Dim Oldvalue As Variant
        Dim Newvalue As Variant
       
        If rngTarg.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo ExitSub
        Else
            If rngTarg.Value = "" Then GoTo ExitSub
            On Error GoTo ExitSub
            Application.EnableEvents = False
            Newvalue = rngTarg.Value
            Application.Undo
            Oldvalue = rngTarg.Value
            If Oldvalue = "" Then
                rngTarg.Value = Newvalue
            Else
                rngTarg.Value = Oldvalue & ", " & Newvalue
            End If
        End If

    ExitSub:
        'Including a MsgBox tells the user an error has occurred
        'otherwise the user will never know that the code has failed
        If Err.Number <> 0 Then
            MsgBox "Error occurred in Sub MultiSelect"
        End If
       
        Application.EnableEvents = True

    End Sub


    Regards, OssieMac

    Friday, May 5, 2017 11:40 PM