Multiselect dropdown lijst

[Martijnbm]

Hallo hallo,

ik heb ergens een stukje code gevonden om meerdere selecties vanuit een dropdown lijst te krijgen. Het probleem is echter dat, wanneer ik meerdere selecties heb en ik één van de selecties nogmaals aanklik, die selectie niet weg gehaald wordt.

Selecteer ik Jan en vervolgens Kees, dan geeft de cel "Jan, Kees" aan. Selecteer ik dan nogmaals Kees, dan moet het weer "Jan" zijn. Bij onderstaande code werkt dat echter niet.

Wat gaat hier verkeerd?


Private Sub Worksheet_Change(ByVal Target As Range)

' Initializing variables
Dim oldVal As String
Dim newVal As String

' Checking for changes in the drop down lists

Application.EnableEvents = True

If Target.Address = "$AI$6" Or Target.Address = "$AI$7" Then

If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
Exit Sub
' Adding the multiple selected items to the list
Else
If Target.Value = "" Then
Exit Sub

Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
If oldVal = "" Then
Target.Value = newVal
Else
If InStr(oldVal, newVal) = 0 Then
Target.Value = oldVal & ", " & newVal '& vbNewLine &
Else
Target.Value = oldVal
End If
End If
End If
End If
End If

Application.EnableEvents = True

End Sub

 

[edmoor]

Klik eens op de link in mijn handtekening en kijk dan bij Gebruik Code tags.

 

[JeanPaul28]

Bij mij werkt die prima

 

[Martijnbm]

Private Sub Worksheet_Change(ByVal Target As Range)

' Initializing variables
Dim oldVal As String
Dim newVal As String

' Checking for changes in the drop down lists

Application.EnableEvents = True

If Target.Address = "$AI$6" Or Target.Address = "$AI$7" Then
    
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
        Exit Sub
' Adding the multiple selected items to the list
    Else
        If Target.Value = "" Then
            Exit Sub

        Else
            Application.EnableEvents = False
            newVal = Target.Value
            Application.Undo
            oldVal = Target.Value
            If oldVal = "" Then
                Target.Value = newVal
            Else
                If InStr(oldVal, newVal) = 0 Then
                    Target.Value = oldVal & ", " & newVal '& vbNewLine &
                Else
                    Target.Value = oldVal
                End If
            End If
        End If
    End If
End If

Application.EnableEvents = True

End Sub

 

[Martijnbm]

Wanneer ik extra keuzes selecteer komen ze er netjes bij. Selecteer ik één van de reeds gemaakte keuzes, dan blijft deze gewoon staan. Zelfs wanneer ik het veld overschrijf met één van de keuzes dan blijven alle keuzes staan.
Vreemd...

 

[Martijnbm]

Heeft iemand een idee hoe dit kan?

 

[HSV]

Ik ga je code niet helemaal aanpassen, maar zo zal het waarschijnlijk werken.

Het laatste stukje code aanpassen.

If InStr(oldVal, newVal) = 0 Then
                    Target.Value = oldVal & ", " & newVal '& vbNewLine &
                Else
[COLOR=#ff0000]                    Target.Value = trim(replace(replace(oldVal, ", " & newval, ""), newval & ",", ""))[/COLOR]
                End If

 

[edmoor]

Daarnaast moet deze regel, de eerste bovenin niet True maar False zijn:

Application.EnableEvents = True [COLOR="#008000"]'False[/COLOR]

 

[HSV]

Die regel kun je beter verwijderen.
Het gaat niet weer op True bij Exit Sub als je die op False staat.

 

[Martijnbm]

Ah, top. Het werkt jongens.
In de macro staan 2 specifieke cellen als target genoemd. Wanneer ik de hele kolom als target cell wil benoemen, hoe doe ik dat?

 

[edmoor]

Zo?

[COLOR="#008000"]'35 = kolom AI[/COLOR]
If Target.Column = 35 then

 

[Martijnbm]

:thumb::thumb::thumb: