Sorting header row where data format is 9.9.9

Question

I wrote a VBA Code to insert specific numbers of my office-related stuff into another Excel sheet which puts them together and calculates cost relevant stuff.

Now I want to sort my "office numbers" which look like this "1.2.30", "1.1.1130" or "1.3.150" in a row from left to right. To sort I have to change them, the question is how to do this?

Also in the columns there are other numbers I want to switch with the "office numbers" in the header row.

Example

Sorting this:

1.2.30   1.1.1130  1.3.150

1        4         7      
2        5         8
3        6         9

To this:

1.1.1130   1.2.30   1.3.150

4          1        7
5          2        8
6          3        9

Excel would sort it like this: 1.2.30, 1.3.150, 1.1.1130

I have to find a way to change those numbers into normal numbers (which I already did by excluding those ".") and to save them as a string after the last point and adding as many "0" so I have standardized numbers with 5 numbers long I guess?

So all my office numbers after the last point looks like this: 1.2.30 = (1.2.)00030, 1.3.150 = (1.3.)150 = 00150 and 1.1.1130 = (1.1.)01130

Code to sort I tried so far:

Sub Table1Sort()

    Range("B39:Q39").Select
    Selection.ClearContents

    Range("B44:Q44").Select
    Selection.ClearContents

    Range("B9:Q28").Select

    ActiveWorkbook.Worksheets("Table1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Table1").Sort.SortFields.Add2 Key:=Range( _
        "B10:Q10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Table1").Sort
        .SetRange Range("B9:Q28")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

    Dim rng As Range

    For Each rng In Range("B9:Q9")
        rng = rng
    Next

End Sub

Saving the numbers as strings and adding zeros maybe? Or maybe my logic is all wrong?

Can you edit your question to include the code you've tried? — Miles Fett, Sep 23 '19 at 14:06
Start with the macro recorder. Do as much as you can with the Excel GUI while recording your steps, then modify the code it generates for you. — nicomp, Sep 23 '19 at 14:09
i added the code i recorded with macro to sort the numbers, but as i already mentioned i have to do something about the wrong order excel sort it. — Risk, Sep 23 '19 at 14:14
Read this about [How to avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Miles Fett, Sep 23 '19 at 14:15
Thank you, u have a good point i should change my code to avoid problems. Still even after changing my code i still have no clue how to solve my problem regarding sorting my "Office numbers". — Risk, Sep 23 '19 at 14:32
I think you have the right approach. Store the original numbers in a 2 dimensional array, strip the decimal points out one dimension & pad the end of the it with zeros to get uniform lengths. Sort the array by the reformatted dimension and write the original number to the target cell. — Barry, Sep 23 '19 at 14:37
yes i somehow mixed it up after working on solutions all day. i edited it so it makes sense again. I think you are right about the sort method but still i thought i hear your opinions, maybe my logic is just wrong. — Risk, Sep 23 '19 at 15:00

score 1 · Accepted Answer · answered Sep 23 '19 at 16:15

Suggested solution below.

Sub Table1Sort()
    Dim i As Long
    Dim rg As Range, cl As Range
    Dim parts As Variant
    Dim fmt As String, id As String

    fmt = String(4, "0")                                        'in this case 4 seems to be the max lenght of number parts, adjust as needed
    Set rg = Range("A1:C5")                                     'your range to get sorted - adjust to the correct address

    For Each cl In rg.Rows(1).Cells                             'Transform numbers into a sort string, unless blank
        If cl <> "" Then
            id = ""
            parts = Split(cl.Text, ".")                             'Split into parts by numbers, pad with leading zeroes and concatenate with a separator
            For i = 0 To UBound(parts)
                id = id & "-" & Format(CInt(parts(i)), fmt)
            Next i
            id = Mid(id, 2)                                         'Remove leading separator
            cl.Value = id                                           'Put into cell
        End If
    Next cl

    ActiveWorkbook.Worksheets("Table1").Sort.SortFields.Clear                       'Do the sorting
    ActiveWorkbook.Worksheets("Table1").Sort.SortFields.Add2 Key:=rg.Rows(1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Table1").Sort
        .SetRange rg
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

    For Each cl In rg.Rows(1).Cells                           'Transform sort strings back to original
        If cl <> "" Then
            id = ""
            parts = Split(cl.Text, "-")
            For i = 0 To UBound(parts)
                id = id & "." & CInt(parts(i))
            Next i
            id = Mid(id, 2)
            cl.Value = id
        End If
    Next cl

End Sub

You could also consider passing the target range as parameter.

Thank you this helped me a lot. I found a solution thanks to yor answer! — Risk, Sep 24 '19 at 06:05
i added my finished code as a answer in this post, thank you again u helped me a lot! — Risk, Sep 26 '19 at 12:40

score 0 · Answer 2 · answered Sep 24 '19 at 14:17

Here's what I came up with:

Option Explicit


Sub Table1Sort()
    Dim i As Integer
    Dim iRows As Integer
    Dim iLen As Integer
    Dim Arr() As Variant

    ActiveSheet.Range("d3:e5").Select  'I randomly entered the values to be sorted in a column here.

    iRows = Selection.Rows.Count 'Figure out how many items I'm dealing with.
    Arr = Range("d3:e5").Value2  'Write them to an array. I include the column next to the data as a placeholder.

    For i = 1 To iRows  'Strip periods and fill/overwrite 2nd column of array
        Arr(i, 2) = Replace(Arr(i, 1), ".", "")
        If Len(Arr(i, 2)) > iLen Then iLen = Len(Arr(i, 2))
    Next i

    For i = 1 To iRows 'Pad with trailing zeros
        Do While Len(Arr(i, 2)) < iLen
            Arr(i, 2) = Arr(i, 2) & "0"
        Loop
    Next i

    QuickSortArray Arr, , , 2  'Call the sort found here: https://stackoverflow.com/a/5104206/12000364

    For i = 1 To iRows  'Write the results out across columns. I randomly start at column F.
        Cells(1, 5 + i) = Arr(i, 1)
    Next i

End Sub

As I mentioned in the code comments, I used the multidimensional array sort found here - https://stackoverflow.com/a/5104206/12000364 and sorted on the 2nd dimension.

Risk · Answer 3 · 2019-09-26T12:38:05.603

This is my finished code with the Help of @Dschuli and @Miles Fett.

Now it works without any Problems :)

Sub Table1Sort()
    Dim i As Long
    Dim rg As Range, cl As Range
    Dim parts As Variant
    Dim fmt As String, id As String

    fmt = String(5, "0")                                        
    Set rg = Tabelle1.Range("B9:Q28")                          

    For Each cl In rg.Rows(1).Cells                             
        If cl <> "" Then
            id = ""
            parts = Split(cl.Text, ".")                             
            For i = 0 To UBound(parts)
                id = id & "-" & Format(CInt(parts(i)), fmt)
            Next i
            id = Mid(id, 2)                                         
            cl.Value = id                                           
        End If
    Next cl


    Tabelle1.Sort.SortFields.Clear                                                  
    Tabelle1.Sort.SortFields.Add Key:=rg.Rows(1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With Tabelle1.Sort
        .SetRange rg
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

    Tabelle1.Range("B39:Q39").ClearContents
    Tabelle1.Range("B44:Q44").ClearContents


    For Each cl In rg.Rows(1).Cells                           
        If cl <> "" Then
            id = ""
            parts = Split(cl.Text, "-")
            For i = 0 To UBound(parts)
                id = id & "." & CInt(parts(i))
            Next i
            id = Mid(id, 2)
            cl.Value = id
        End If
    Next cl
End Sub

Sorting header row where data format is 9.9.9

3 Answers3