Select Multiple Names from Cell

That article doesn't seem to be available so try this. Add this code that I found on the web to the sheet with the validation list. To use it you select the values one at a time and it creates a comma separated list.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    If Target.Count > 1 Then
        Exit Sub
    End If
    On Error Resume Next
    Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then
        Exit Sub
    End If
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                Target.Value = xValue1 & ", " & xValue2
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

Select allOpen in new window

Hi ,

Thanks for your quick response . It works fine and i understood the logic . thanks for your support.

Regards,

Aaron

HI
Could you please advice how can i have multiple entry instead of comma to be newline in the same cell .

Regards,

Aaron

The following line will do what you are asking......

Target.Value = xValue1 & vbCrLf & xValue2

Select allOpen in new window

Also were you interested in selecting duplicate values from the drop down as you didn't respond to my post?

Hi . Thanks for the reply . where do i add it ?

The objective is to select the multiple values from the list . These values will not be duplicated .

Eg: If i select red, blue , green - multiple list for me would be red,blue,green  or red,blue

Not red, blue , blue etc . Also i would like to have in different newline (alt+enter) , just to make it as good formatted document .

Regards,
SID

The objective is to select the multiple values from the list . These values will not be duplicated .

If this was the case, why didn you accept the Martin's solution as the only accepted solution?
Did you not read my post before accepting that solution?

If this is the case, you may use Request Attention to reopen the question and may distribute the points by accepting both the solutions.

This code is for Worksheet Change Event and must be placed on the Sheet Module not on Standard Module. To apply the code to your workbook, follow these steps....

1) Open your workbook.

2) Right Click the Sheet Tab on which you want this code to work --> Select View Code

3) Now paste the code given below into the opened code window.

4) Close the VBA Editor.

5) Save your workbook as Macro-Enabled Workbook.

6) Now your workbook will be saved with the same name but with .xlsm file extension.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    If Target.Count > 1 Then
        Exit Sub
    End If
    On Error Resume Next
    Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then
        Exit Sub
    End If
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If InStr(xValue1, xValue2) = 0 Then
                    Target.Value = xValue1 & vbCrLf & xValue2
                Else
                    Target.Value = xValue1
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

Select allOpen in new window

Hope this helps.

Hi ,
Thanks all , it is working as per my expectation . I have emailed moderator for equal point distributor.
Thanks for your support again .

regards,
Aaron aka SID

You're welcome Aaron!
Glad I could help.

You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015, Experts-Exchange Top Expert Visual Basic Classic 2012 to 2014