Multiple Selection din DropDown

[BioHazarD]

Salutare,
Am si eu nevoie de putin ajutor cu o bucata de cod ce-mi permite sa fac multiple selection dintr-un drop down list.

Concret, am o lista de genul:
Please select
Not Applicable
Country 1
Country 2
...
Country n

Codul functioneaza, doar ca am nevoie sa:
1. cand se selecteaza NA din lista, sa nu ma lase sa aleg si alte raspunsuri - eventual cu un mesaj de atentionare cand se incearca asta
2. please select este "raspunsul default" pe care-l vede utilizatorul, si as vrea ca acesta sa fie ignorat cand se alege o tara sau mai multe din lista

Stie cineva cum sa-l modifice pt asta?

Cod: Selectaţi tot

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim Oldvalue As String 
    Dim Newvalue As String 
    On Error Goto Exitsub 
    If Target.Address = "$C$38" 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 

[csaba1960]

Buna

Am modificat ușor codul, sper ca se pliază pe nevoile tale.

[BioHazarD]

In xls de test, merge cum ar trebui.
Sa vedem si in fisierul original...

Tks!

[BioHazarD]

In xls de test, merge cum ar trebui.
Sa vedem si in fisierul original...

Tks!

A mers de minune. Am avut ceva probleme cu xls-ul original, se pare ca nu accepta functia daca sheetul este protejat dar am rezolvat pana la urma.
Ms inca o data.

Cod: Selectaţi tot

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Oldvalue As String
    Dim Newvalue As String
    On Error GoTo Exitsub
    ActiveSheet.Unprotect
    If Target.Address = "$C$38" 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 = "Not Applicable" Then GoTo Exitsub 
            If Oldvalue = "" Then
                Target.value = Newvalue
            Else
                    If Oldvalue = "Please Select" Then  
                    Target.value = Newvalue
                    Else: Target.value = Oldvalue & ", " & Newvalue
                    End If
            End If
        End If
    End If
    Application.EnableEvents = True
Exitsub:
    Application.EnableEvents = True
ActiveSheet.Protect , AllowFormattingRows:=True

End Sub