Consulting

Results 1 to 11 of 11

Thread: Solved: Multiple Selection for Dropdown

  1. #1
    VBAX Regular
    Joined
    Feb 2012
    Posts
    11
    Location

    Solved: Multiple Selection for Dropdown

    Hello All

    Could someone help me with this code. This is what I want it to do:

    When the user is presented with a drop down box in column C, the user is presented with the options 1,2,3, 4, 5 and so on. The code is supposed to allow the user to select as many numbers as they want, and they appear below each other with a line break. The code does this fine.

    However, the code is also supposed to let the user delete selections made: if they select 1,2,3 and 4, they should be able to reselect '3' and that deletes '3' from the cell. However, it only works insofar as it allows the user to delete the last entry (in this case '4') and not the other entries.

    I hope I've explained this okay. Grateful for any help that anyone can offer. I should point out that this is some code that I've found (and modified) on the internet.

    Thanks.

    [VBA]Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    Dim lUsed As Long
    If Target.Count > 1 Then GoTo exitHandler
    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler
    If rngDV Is Nothing Then GoTo exitHandler
    If Intersect(Target, rngDV) Is Nothing Then
    'do nothing
    Else
    Application.EnableEvents = False
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
    Target.Value = newVal
    If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Then
    If oldVal = "" Then
    'do nothing
    Else
    If newVal = "" Then
    'do nothing
    Else
    lUsed = InStr(1, oldVal, newVal)
    If lUsed > 0 Then
    If Right(oldVal, Len(newVal)) = newVal Then
    Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
    Else
    Target.Value = Replace(oldVal, newVal & ", ", "")
    End If
    Else
    Target.Value = oldVal _
    & vbLf & newVal
    End If

    End If
    End If
    End If
    End If
    exitHandler:
    Application.EnableEvents = True
    End Sub[/VBA]

  2. #2
    VBAX Regular
    Joined
    Feb 2012
    Posts
    11
    Location
    Bump...

    Is there anyone who can help me with this.... or at least help me understand why no one has replied....?

    Thanks

    llyamah

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,874
    Try changing:
    Target.Value = Replace(oldVal, newVal & ", ", "")
    to:
    Target.Value = Replace(oldVal, newVal & vbLf, "")

    It still doesn't get rid of a single value if that value is reselected, but you might not want that.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    VBAX Regular
    Joined
    Feb 2012
    Posts
    11
    Location
    Quote Originally Posted by p45cal
    Try changing:
    Target.Value = Replace(oldVal, newVal & ", ", "")
    to:
    Target.Value = Replace(oldVal, newVal & vbLf, "")

    It still doesn't get rid of a single value if that value is reselected, but you might not want that.
    Thanks p45cal, appreciated - I'll try that when I get into work. However, do you know how I can make it so that it gets rid of a single value if that value is reselected? It does seem to do this at the moment, but it'll only get rid of the last value selected (if the reselected value is the same).

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,874
    Quote Originally Posted by llyamah
    Thanks p45cal, appreciated - I'll try that when I get into work. However, do you know how I can make it so that it gets rid of a single value if that value is reselected? It does seem to do this at the moment, but it'll only get rid of the last value selected (if the reselected value is the same).
    All that has been addressed. I'm saying that if there is only one value left in the cell, it doesn't lose it (and become a blank cell) if you reselect that value.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #6
    VBAX Regular
    Joined
    Feb 2012
    Posts
    11
    Location
    Quote Originally Posted by p45cal
    All that has been addressed. I'm saying that if there is only one value left in the cell, it doesn't lose it (and become a blank cell) if you reselect that value.
    Thank you so so much. It all works as I want it too. I am so grateful for your help with this.

  7. #7
    VBAX Newbie
    Joined
    Sep 2012
    Posts
    3
    Location
    Could you please post the working code. I cannot delete without getting an error.

  8. #8
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,874
    Quote Originally Posted by Chatis
    Could you please post the working code. I cannot delete without getting an error.
    [VBA]Private Sub Worksheet_Change(ByVal Target As Range)
    'http://www.vbaexpress.com/forum/showthread.php?t=41148
    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    Dim lUsed As Long
    If Target.Count > 1 Then GoTo exitHandler
    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler
    If rngDV Is Nothing Then GoTo exitHandler
    If Intersect(Target, rngDV) Is Nothing Then
    'do nothing
    Else
    Application.EnableEvents = False
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
    Target.Value = newVal
    If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Then
    If oldVal = "" Then
    'do nothing
    Else
    If newVal = "" Then
    'do nothing
    Else
    lUsed = InStr(1, oldVal, newVal)
    If lUsed > 0 Then
    If oldVal = newVal Then
    Target.Value = ""
    ElseIf Right(oldVal, Len(newVal)) = newVal Then
    Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
    Else
    Target.Value = Replace(oldVal, newVal & vbLf, "")
    End If
    Else
    Target.Value = oldVal & vbLf & newVal
    End If
    End If
    End If
    End If
    End If
    exitHandler:
    Application.EnableEvents = True
    End Sub
    [/VBA]
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  9. #9
    VBAX Newbie
    Joined
    Sep 2012
    Posts
    3
    Location
    Thank you! Works very well!

  10. #10
    Can you please share that excel with code

  11. #11
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,874
    Quote Originally Posted by vijidivesh@ View Post
    Can you please share that excel with code
    Attached.
    Attached Files Attached Files
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •