• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

sorting of cells with different data types

Pete Wright

Member
Hi!

Is there a simple trick to sort cells that contain different data types?

the data types are mostly numbers with or without a forward slash.

For example:
"123", "456", "456/789", "100/200", "987/321",...

On my work laptop there is Office 365 and its Excel has only two sorting algorithms: A-Z and Z-A (even in custom sorting).

Now I have read about some workarounds using helper cells, but maybe some of you know anything else.

BTW., the cells are sorted using a button which fires up a VBA sub:

>>> use code - tags <<<
Code:
Dim ws As Worksheet: Set ws = This Workbook.Worksheets("data")
with ws.Sort
.SortFields.Add Key:=ws.Range("A1"), Order:=xlAscending, DataOption:=xlSortNormal
.SetRange ws.Range("A1:A1000")
.Header = xlYes
.Apply
End With
 
Last edited by a moderator:

AlanSidman

Well-Known Member
Based upon the data shown above, what would your solution look like. I don't know how you wish to have these sorted.
 

Pete Wright

Member
Aw, sorry. Forgot about that.

The first three numbers of each value should be sorted.
100/200
123
456
456/789
987/321
 

mohadin

Active Member
Hi
IF I right understand
may be
Code:
Sub test()
    Dim a, b, x As Variant
    Dim i, ii As Long
    a = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)).Resize(, 2)
    For i = 1 To UBound(a)
        x = Split(a(i, 1))
        ReDim b(1 To UBound(x) + 1, 1 To 2)
        For ii = 0 To UBound(x)
            b(ii + 1, 1) = Split(x(ii), ",")(0)
            If UBound(Split(x(ii), "/")) > 0 Then
                b(ii + 1, 2) = Split(x(ii), "/")(0) & Split(x(ii), "/")(1)
            Else
                b(ii + 1, 2) = Split(x(ii), "/")(0)
            End If
        Next
        b = Sort(b, 2)
        ReDim Preserve b(1 To UBound(b), 1 To 1)
        Cells(i, 2) = Join(Application.Transpose(b), ",")
    Next
End Sub
Function Sort(a As Variant, s_col As Integer)
    Dim LB, ub, ub2, lb2
    Dim flag As Boolean
    Dim i, ii
    Dim temp
    LB = LBound(a, 1): ub = UBound(a, 1): ub2 = UBound(a, 2): lb2 = LBound(a, 2)
    flag = True
    Do While flag
        flag = False
        For ii = LB To ub - 1
            If a(ii, s_col) = 0 Then a(ii, s_col) = 100000 Else
            If a(1 + ii, s_col) < a(ii, s_col) Then
                flag = True
                For i = lb2 To ub2
                    temp = a(1 + ii, i): a(1 + ii, i) = a(ii, i): a(ii, i) = temp
                Next i
            End If
        Next ii
    Loop
    Sort = a
End Function
PS. Presume: Your data start from Range("A1") down
 

AlanSidman

Well-Known Member
Alternative Solution with Power Query
Code:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Split Column by Delimiter" = Table.SplitColumn(Table.TransformColumnTypes(Source, {{"Column1", type text}}, "en-US"), "Column1", Splitter.SplitTextByDelimiter("/", QuoteStyle.Csv), {"Column1.1", "Column1.2"}),
    #"Changed Type" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Column1.1", Int64.Type}, {"Column1.2", Int64.Type}}),
    #"Sorted Rows" = Table.Sort(#"Changed Type",{{"Column1.1", Order.Ascending}, {"Column1.2", Order.Ascending}}),
    #"Merged Columns" = Table.CombineColumns(Table.TransformColumnTypes(#"Sorted Rows", {{"Column1.1", type text}, {"Column1.2", type text}}, "en-US"),{"Column1.1", "Column1.2"},Combiner.CombineTextByDelimiter("/", QuoteStyle.None),"Merged")
in
    #"Merged Columns"
 

mohadin

Active Member
This could be faster a bit
Code:
Sub test()
    Dim a, b, x As Variant
    Dim i, ii As Long
    a = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)).Resize(, 2)
    For i = 1 To UBound(a)
        x = Split(a(i, 1))
        ReDim b(1 To UBound(x) + 1, 1 To 2)
        For ii = 0 To UBound(x)
            b(ii + 1, 1) = Split(x(ii), ",")(0)
            If UBound(Split(x(ii), "/")) > 0 Then
                b(ii + 1, 2) = Split(x(ii), "/")(0) & Split(x(ii), "/")(1)
            Else
                b(ii + 1, 2) = Split(x(ii), "/")(0)
            End If
        Next
        b = Sort(b, 2)
        ReDim Preserve b(1 To UBound(b), 1 To 1)
        a(i, 1) = Join(Application.Transpose(b), ",")
    Next
    Cells(1, 2).Resize(UBound(a)) = a
End Sub
Function Sort(a As Variant, s_col As Integer)
    Dim LB, ub, ub2, lb2
    Dim flag As Boolean
    Dim i, ii
    Dim temp
    LB = LBound(a, 1): ub = UBound(a, 1): ub2 = UBound(a, 2): lb2 = LBound(a, 2)
    flag = True
    Do While flag
        flag = False
        For ii = LB To ub - 1
            If a(ii, s_col) = 0 Then a(ii, s_col) = 100000 Else
            If a(1 + ii, s_col) < a(ii, s_col) Then
                flag = True
                For i = lb2 To ub2
                    temp = a(1 + ii, i): a(1 + ii, i) = a(ii, i): a(ii, i) = temp
                Next i
            End If
        Next ii
    Loop
    Sort = a
End Function
 

vletm

Excel Ninja
Pete Wright
Basic VBA Sort with pre - 'any letter' ... eg with A
Code:
Sub Sort_It()
    With ActiveSheet
        a_max = .Cells(.Rows.Count, "A").End(xlUp).Row
        For a = 1 To a_max
            .Cells(a, "A") = "A" & .Cells(a, "A")
        Next a
        With Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=Range("A1:A" & a_max), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A1:A" & a_max)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        For a = 1 To a_max
            .Cells(a, "A") = Mid(.Cells(a, "A"), 2, 999)
        Next a
    End With
End Sub
 
Top