Multiple Items in Data Validation List

[boilermaker1997]

I found the following code on another website. It allows you to choose multiple items in a data validation list and display them in the same cell. The items are separated by commas. In addition, you can re-select an item and it will be removed from the cell.

I was wondering if someone would look at the code and tell me how to change it so the items are separated by a line break in the cell rather than commas.

Here is the code:

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 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) - 2)
Else
Target.Value = Replace(oldVal, newVal & ", ", "")
End If
Else
Target.Value = oldVal _
& ", " & newVal
End If

End If
End If
End If
End If

exitHandler:
Application.EnableEvents = True
End Sub

 

[Jerry Sullivan]

1. The first one is when copying and pasting the data validation, the items are pasted in sequence with quotes, for example:

"HELLOWORLD"

Instead of:


HELLO
WORLD

Are you copying then Pastespecial > Paste as values?
When I do that, "HELLOWORLD" is displayed without quotes.
The linefeed character is still in there to separate the rows, but you need to "reenter" the value to get the formatting to apply (F2 key then enter).

2. When updating items currently part of my Reference List, the input doesn't update automatically. For Example:

Updating HELLO to HI, the input on the main spreadsheet remains HELLO, even though the Data Validation contains HI.

This in itself causes two other problems within it. First, when adding the new item, the old item is NOT deleted and second, if deleting the single item, the spreadsheet clears the cell (this is an issue if multiple items are on the cell).

You could use Worksheet_Change event code to trigger whenever a value in your DV list source ranges is changed. It could do a find and replace in the cells with DV dropdowns for whatever expression was changed.

This would be pretty straight-forward for a single change. It could get complicated if you need to handle other scenarios like, insertions, deletions, or changes to multiple cells in the DV list source (like Change HELLO to WORLD and WORLD to HELLO).

Can you further define any scenarios this would need to handle besides a change to a single value in the DV List?

 

[daryaabi]

Hello , I used these codes and it worked perfectly last week , today I was working on my Excel and changes some part but not the cods and now it is not working is it possible to send you my Excel and see what I am doing wrong?

Hi boilermaker1997,

That's an interesting idea.

Below is some code you can try.....

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDV As Range
    Dim oldVal As String, newVal As String
    
    On Error GoTo exitHandler
    If Target.Count > 1 Or Target.Text = "" Then Exit Sub
    
    Set rngDV = Intersect(Columns("C"), _
        Target.SpecialCells(xlCellTypeSameValidation))
    If rngDV Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    newVal = Target.Text
    Application.Undo
    oldVal = Target.Text
    Target.Value = newVal
    If oldVal = "" Then GoTo exitHandler
    
    If oldVal = newVal Then
        Target.Value = ""
    ElseIf InStr(1, oldVal, newVal) > 0 Then
        If Right(oldVal, Len(newVal)) = newVal Then
            Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
        Else
            Target.Value = Replace(oldVal, newVal & Chr(10), "")
        End If
    Else
        Target.Value = oldVal & Chr(10) & newVal
    End If
  
exitHandler:
    Application.EnableEvents = True
End Sub

 

[Jerry Sullivan]

Hello , I used these codes and it worked perfectly last week , today I was working on my Excel and changes some part but not the cods and now it is not working is it possible to send you my Excel and see what I am doing wrong?

Hi daryaabi, Looks like you've started a new thread on this. I'll respond to you there.
http://www.mrexcel.com/forum/excel-questions/771405-multiple-data-selection.html#post3779969

 

[daryaabi]

How you apply these cods for different columns ?not just one specific column?

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 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) - 2)
            Else
                Target.Value = Replace(oldVal, newVal & ", ", "")
            End If
        Else
            Target.Value = oldVal _
              & ", " & newVal
        End If
        
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

 

[Jdog20]

Question: The code associated to response #8 inserts multiple selections in a specific column and deletes duplicate selections. Is there a way to rewrite the code so that multiple selections are not deleted?