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?

Answer 1

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

Answer 2

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.

Answer 3

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.