Choosing multiple items from drop down list

[Fdjaynes]

I have found a code online to be able to choose multiple items from a drop down list in excel. The field shows a list of counties. This works to let me choose one or more items, each separated by the word "And".

Is there any way to change when there are three or more chosen to show commas as the separator for all but the last one? Example

Able AND Baker AND Charlie and Delta

would become

Able, Baker, Charlie, and Delta

If there were only two selected it would just be Able and Baker


If that can be accomplished, is there anyway to repeat the action in another cell. I am currently using it in cell B4 but would like to repeat the process in cell B27.

Below is the code that I am using that I found online. I would appreciate any help because I really don't understand how to write vba.

Fred





Private Sub Worksheet_Change(ByVal Target As Range)



'Code by Sumit Bansal from Online Excel Tips & Tutorials

' To make mutliple selections in a Drop Down List in Excel



Dim Oldvalue As String

Dim Newvalue As String



On Error GoTo Exitsub

If Target.Address = "$B$4" Then

If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then

GoTo Exitsub

Else: If Target.Value = "" Then GoTo Exitsub Else

Application.EnableEvents = False

Newvalue = Target.Value

Application.Undo

Oldvalue = Target.Value

If Oldvalue = "" Then

Target.Value = Newvalue

Else

Target.Value = Oldvalue & " and " & Newvalue

End If

End If

End If

Application.EnableEvents = True

Exitsub:

Application.EnableEvents = True

End Sub

 

[MikeVol]

Hello @Fdjaynes.
Try next updated code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CombinedValue As String
    Dim Result      As String
    On Error GoTo Exitsub

    If Target.Address = "$B$4" Then
        If Target.Validation.Type <> xlValidateList Then GoTo Exitsub
        If Target.Value = "" Then GoTo Exitsub
        Application.EnableEvents = False

        Dim Newvalue As String
        Newvalue = Target.Value
        Application.Undo

        Dim Oldvalue As String
        Oldvalue = Target.Value

        If Oldvalue = "" Then
            Target.Value = Newvalue
        Else

            If InStr(Oldvalue, " and ") > 0 Then
                Oldvalue = Replace(Oldvalue, " and ", ", ")
            End If

            CombinedValue = Oldvalue & ", " & Newvalue
            Dim Values() As String
            Values = Split(CombinedValue, ", ")

            If UBound(Values) = 0 Then
                Result = Values(0)
            ElseIf UBound(Values) = 1 Then
                Result = Values(0) & " and " & Values(1)
            Else
                Dim i As Long

                For i = 0 To UBound(Values) - 1
                    Result = Result & Values(i) & ", "
                Next i

                Result = Left(Result, Len(Result) - 2) & " and " & Values(UBound(Values))
            End If

            Target.Value = Result
        End If

    End If

    Application.EnableEvents = True
Exitsub:
    Application.EnableEvents = True
End Sub

Also, please add information to your profile on this forum, your office version, etc.
I hope I understood you correctly and was able to help you. Good luck.

 

[Fdjaynes]

MikeVol, Thank you so much that works great and does exactly what I wanted. Now, let me ask, is there a way to do the same thing in another cell in the same worksheet?

 

[MikeVol]

Yes, it is possible.
Replace this line in the code:

    If Target.Address = "$B$4" Then

to

    If Target.Address = "$B$4" Or Target.Address = "$D$4" Then

Now this code will work for cell B4 and for cell D4 as well. Replace D4 with your cell.

 

[Fdjaynes]

MikeVol, that is perfect. Thank you so much for your help.
Fred