How do I auto sort contents in a cell without a macro?

0

For each cell I wish to sort, I separate the items (words) with a comma. I am trying to automatically sort each of these cells without having to use a macro key. I currently use a macro with key combination Ctrl-T with the following VBA code:

CODE

Option Explicit

Public Sub SortVals()
    Dim i As Integer
    Dim arr As Variant
    arr = Split(ActiveCell.Text, ",")

    ' trim values so sort will work properly
    For i = LBound(arr) To UBound(arr)
        arr(i) = Trim(arr(i))
    Next i

    ' sort
    QuickSort arr, LBound(arr), UBound(arr)

    ' load sorted values back to cell
    Dim comma As String
    comma = ""
    ActiveCell = ""
    For i = LBound(arr) To UBound(arr)
        ActiveCell = ActiveCell & comma & CStr(arr(i))
        comma = ", "
    Next i
End Sub

Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)

  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)

     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If

  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi

End Sub

CODE

So I would like to use the above code with a selection change if possible for all the cells in column B and D.

Answer
Discuss

Answers

0
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
Discuss

Discussion

Thanks, it appears to be working. I slightly modified the comma separator to add a space after each comma but otherwise seems fine.
sooboksim (rep: 2) Nov 3, '19 at 10:12 am
If you add a space to the separator I suggest you read the string with this code: 
Arr = Split(.Value, Trim(Separator)). The spaces, if they are present, will be trimmed out in the next action the macro takes.
Variatus (rep: 3243) Nov 3, '19 at 2:19 pm
This doesn't sort when I have only two items. eg: "this, is" remains "this, is" instead of sorting to "is, this"
sooboksim (rep: 2) Nov 16, '19 at 12:23 pm
Thank you for pointing out this logical error in my function. I have corrected it in my post. Please read the edit remark at the bottom of my post.
Variatus (rep: 3243) Nov 16, '19 at 7:42 pm
Thanks again!
sooboksim (rep: 2) Nov 17, '19 at 9:20 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login