Sort Data Validation dropdown list within cell

Question

I have implemented a data validation in-cell drop down list that I use to retain multiple values in a column of cells. Currently you can select from the dropdown list in any order and the cell will populate in that order. Is there a way to force the order to stay consistent with the list that is the source for my dropdown?

For example: My dropdown list is:

Jim
Tom
Bob
Aaron

The selections are made in this order:

Bob
Jim
Tom

I want the cell to display:

Jim, Tom, Bob

Below is my current VBA code for the data validation drop down list:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    ' To allow multiple selections in a Drop Down List
    Dim Oldvalue As String
    Dim Newvalue As String

    Application.EnableEvents = True

    On Error GoTo Exitsub
    If Target.Column = 13 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
                    If InStr(1, Oldvalue, Newvalue) = 0 Then
                        Target.Value = Oldvalue & ", " & Newvalue
                    Else
                        Target.Value = Oldvalue
                    End If
                End If
            End If
        End If
    End If
Exitsub:
    Application.EnableEvents = True
End Sub

So, below is a quick example screenshot:

Basically, the code above (given to me by a former coworker, not of my own invention) lets me keep multiple selections from the list in the cell, separated by a comma. That works great, but the selections from the list are presented in the cell in the order they were chosen.

I need them to show up in the order they are in in the list. From the example, if someone chooses Bob, then Tom, then Ryan, the current code displays Bob, Tom, Ryan. I need the code to re-sort the selections to display as Tom, Bob, Ryan.

https://stackoverflow.com/questions/152319/vba-array-sort-function — Tim Williams, Aug 17 '18 at 19:46
So, if I'm reading those responses correctly, they are all sorting small to large. I need to sort based on the order of the original source list. — J Welsh, Aug 17 '18 at 20:36
@JWelsh could you edit this post and include a couple screenshots or examples of the problem your facing? It would make it easier to approach :) — Kubie, Aug 17 '18 at 21:07
Is the validation list from a linked range, or directly input into the validation setup? — Tim Williams, Aug 17 '18 at 22:10
The list is a linked range that is selected in Data Validation. — J Welsh, Aug 17 '18 at 22:21

Tim Williams · Answer 1 · 2020-06-18T05:57:27.690

1

Try this out - some changes from your original version, including that if you select something already selected it is removed from the selection.

Private Sub Worksheet_Change(ByVal Target As Range)

    ' To allow multiple selections in a Drop Down List
    Dim Oldvalue As String
    Dim Newvalue As String
    Dim rng As Range, rngToCheck As Range, listVals

    'run some checks
    If rng.Cells.Count > 1 Then Exit Sub '<< this first!

    Set rngToCheck = Me.Range("A1,C1,D1,M1").EntireColumn '<< checking columns A,C,D, M

    Set rng = Application.Intersect(Target, _
               rngToCheck.SpecialCells(xlCellTypeAllValidation))
    If rng Is Nothing Then Exit Sub


    If rng.Value <> "" Then
        On Error GoTo Exitsub
        Application.EnableEvents = False
        Newvalue = rng.Value
        Application.Undo
        Oldvalue = rng.Value
        If Oldvalue = "" Then
            rng.Value = Newvalue
        Else
            listVals = Application.Evaluate(rng.Validation.Formula1).Value
            rng.Value = SortItOut(listVals, Oldvalue, Newvalue) '<< call function
        End If
    End If

Exitsub:
    If Err.Number > 0 Then Debug.Print Err.Description
    Application.EnableEvents = True
End Sub


'Figure out what gets added (or removed) and keep
'  it all in the same order as the validation source range
Private Function SortItOut(listVals, oldVal, newVal)
    Const THE_SEP As String = ", "
    Dim i As Long, arr, s, sep, t, listed, removeNewVal
    s = ""
    sep = ""
    arr = Split(oldVal, THE_SEP)
    'new value already listed?
    removeNewVal = Not IsError(Application.Match(newVal, arr, 0))

    For i = 1 To UBound(listVals, 1)
        t = listVals(i, 1)
        listed = Not IsError(Application.Match(t, arr, 0))
        If listed Or newVal = t Then
            If Not (removeNewVal And newVal = t) Then
                s = s & sep & t
                sep = THE_SEP
            End If
        End If
    Next i

    SortItOut = s
End Function

edited Jun 18 '20 at 05:57

answered Aug 17 '18 at 22:58

Tim Williams

154,628
8
97
125

Hello Tim. I would like ot aks, how to set that this macro will work on several columns? the rng in thhis case work for one column. I try to add few more, but it doesn't work. Thanks – Phantom Jun 18 '20 at 05:36
See my edits above - added `rngToCheck` which defines which columns to monitor. – Tim Williams Jun 18 '20 at 05:58
Thanks. Now I am trying to add new line seperator to Const `THE_SEP`. I would like to be like this: `"; " & Chr(10)`. – Phantom Jun 18 '20 at 18:59
`Const THE_SEP As String = ", " & vbLf` You can't use methods like `Chr()` to define a constant but you can use other constants. Or just make it a regular variable. – Tim Williams Jun 18 '20 at 20:33
Actually I replace `if rng.Cells.Count > 1 Then Exit Sub`with `If Target.Count > 1 Then GoTo exitHandler` and add `exitHandler: Application.EnableEvents = True` before `Exitsub:` otherwise I have an error: >Rutime error '91: Object variable or With block variable not set error – Phantom Jun 19 '20 at 05:07
Tim, is possible to auto update validation value if I rename the value from list. I have a list (product) where I have Item1, Item2, ietm3. In other sheet with validation I already select and assign some of this items from product list and then I saw, that ietm3 should be renamed to item3 (if i select with drop down i see new value, but previusley selected was not changed). I would like that ietm3 would be auto updateted to Item3 in validation, or that this cell will color red so I need to reselect the new Item3.) – Phantom Jun 19 '20 at 07:32
You would need to capture the change event on your validation list, undo/redo so you have the old and new values, then locate all cells which use that list for validation, loop over them and split their values into individual list values, then perform the replace if you find the "old" value. So yes, possible but will not be simple. If you need something like this a "real" database with foreign keys is the answer... – Tim Williams Jun 19 '20 at 15:21

score 0 · Answer 2 · answered Aug 17 '18 at 23:08

You can add this at the top:

Dim nameArray() As String
Dim sortedArray() As Variant: sortedArray = Array("Tom", "Bob", "Ryan") 'etc whatever order you need
Dim finalArray() As Variant
Dim spot1 As Integer
Dim spot2 As Integer: spot2 = 0
Dim name as String

And also include this right under Target.Value = Oldvalue & ", " & Newvalue :

Target.Value = Replace(Target.Value, ",", "")
nameArray = Split(Target.Value)

For spot1 = 0 To UBound(nameArray) 
    For Each name in nameArray
        If name = sortedArray(spot1)
            finalArray(spot2) = name
            spot2 = spot2 + 1
        End If
    Next
Next

Target.Value = ""
For spot1 = 0 To UBound(finalArray)
    If spot1 <> UBound(finalArray) Then
        Target.Value = Target.Value & finalArray(spot1) & ", "
    Else
        Target.Value = finalArray(spot1)
    End If
Next

Couldn't test it myself so make sure u save your file before testing.

Best of luck

Thanks for the responses, I'll try both out Monday morning when I'm back at the office — J Welsh, Aug 17 '18 at 23:30

Sort Data Validation dropdown list within cell

2 Answers2

Linked