Selected Answer
Please try this code. It must be installed in the code module of the worksheet on which you want the action. Such modules are created by Excel automatically for each sheet and are listed in the project explorer by their default names like "Sheet1 (Sheet1)" until you change either the tab name or the sheet's CodeName. Don't use a standard code module which you can insert and would have a default name like "Module1".
If installed in the described location it will sort the currently changed cell (if it's in columns B or D). This should be more suitable than responding to the Selection_Change event because if all cells are sorted when they are changed no cells will need sorting when they are selected. However, just in case, I enabled my procedure to sort multiple cells. So, if you have many unsorted cells you can sort them in one operation using copy/paste.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' 03 Nov 2019
Const Separator As String = ","
Dim Changed As Boolean
Dim Cell As Range
Dim Arr() As String
Dim i As Integer, j As Integer
' prevent changes made by this proc to cause a Change event
Application.EnableEvents = False
For Each Cell In Target
With Cell
' specifies columns B(=2) and D(=4)
If (.Column = 2) Or (.Column = 4) Then
Arr = Split(.Value, Separator)
j = 0
For i = 0 To UBound(Arr)
Arr(i) = Trim(Arr(i))
If Len(Arr(i)) Then
' skip blanks
Arr(j) = Arr(i)
j = j + 1
End If
Next i
If i > j Then
ReDim Preserve Arr(j - 1)
Changed = True
End If
Changed = Changed Or SortArray_S(Arr)
If Changed Then
.Value = Join(Arr, Separator)
.NumberFormat = "@" ' change numbers to Text
End If
End If
End With
Next Cell
Application.EnableEvents = True
End Sub
Private Function SortArray_S(Arr() As String, _
Optional ByVal Cp As VbCompareMethod = vbTextCompare, _
Optional ByVal So As Long = 1) As Boolean
' SSY 050 ++ 16 Nov 2019
' sort single vector string arrays only
' return Not True if no changes were made to Arr()
' blanks are sorted to one end of the vector
' ==================================================
' Parameters:
' Arr() = Array to be sorted
' Cp = vbCompareMethod option
' 0 = vbBinaryCompare (sorts A, Z, a)
' 1 = vbTextCompare (sorts A, a, Z or a, A, Z)
' So = Sort Order
' 1 = Ascending
' -1 = Descending
' ==================================================
Dim Done As Boolean ' True, if no swaps were made in one run
Dim Tmp As String ' Temp used for swapping
Dim i As Long ' Loop index
' ==================================================
On Error Resume Next
i = UBound(Arr)
If i < 1 Then Exit Function ' return (Not Arr) unchanged
On Error GoTo 0
If UBound(Arr) - LBound(Arr) > 0 Then
Do
Done = True
For i = LBound(Arr) To UBound(Arr) - 1
If (StrComp(Arr(i), Arr(i + 1), Cp) = So) Or _
((Cp = vbTextCompare) And _
(StrComp(Arr(i), Arr(i + 1), Cp) = 0) And _
(StrComp(Arr(i), Arr(i + 1), vbBinaryCompare) = So)) Then
Tmp = Arr(i)
Arr(i) = Arr(i + 1)
Arr(i + 1) = Tmp
Done = False
SortArray_S = True
End If
Next i
Loop While Not Done
End If
End Function
The bubble-sort function above is probably more elaborate than what you need. That is because it's a procedure I wrote for another project and just copied here.
16 Nov 2019 Edited ====================
Function SortArray_S was corrected to enable sorting of arrays of less than 3 elements:-
If UBound(Arr) - LBound(Arr) > 0 Then
' was
If UBound(Arr) - LBound(Arr) > 1 Then
