PDA

View Full Version : Solved: Multiple Selection for Dropdown



llyamah
02-28-2012, 10:17 AM
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.

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

llyamah
02-28-2012, 01:49 PM
Bump...

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

Thanks

llyamah

p45cal
02-28-2012, 05:10 PM
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.

llyamah
02-29-2012, 01:21 AM
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).

p45cal
02-29-2012, 01:31 AM
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.

llyamah
02-29-2012, 03:06 AM
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.

Chatis
09-14-2012, 10:12 AM
Could you please post the working code. I cannot delete without getting an error.

p45cal
09-14-2012, 11:24 AM
Could you please post the working code. I cannot delete without getting an error.
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

Chatis
09-14-2012, 01:59 PM
Thank you! Works very well!

vijidivesh@
06-11-2019, 10:48 PM
Can you please share that excel with code

p45cal
06-12-2019, 01:34 AM
Can you please share that excel with code

Attached.