Need help- Sort columns within rows numerically. Cells contain text as well as number

[AlanB]

Hello - I was wondering if anyone can help as I am struggling with a problem after trying on my own and searching for a solution online.

I have various excel documents that I already have and will be regularly creating that I would like to sort some of the headed columns of each row numerically from high to low. In each document the data is always stored in sheet 1. The sheets can have anything from 100 to 40k rows - with each row to be sorted.

Columns A to T in each row each contain text and numbers that can be ignored but the data in columns U To AC is what I would like to rearrange/ sort from high to low (highest in column U lowest in column AC). There is also text in columns after AC that can be ignored.

The data in the cells that I want to rearrange into numerical order has both text and a number (e.g. Cat;20)
I do not want to delete the text during the sort or rearrange the string.
The number always follows a ;
Numbers have no relationship to the word
Some numbers might be the same - e.g. tiger and dog or horse and hamster in the example below- if number match I do not mind the order order but I guess alphabetically would be best if possible.

E.g. for one of the rows before VBA

Row 2 Column U (Header = Skills) Cat;20
Row 2 Column V (Header = Skills 2) Dog;30
Row 2 Column W (Header = Skills 3) Snake;99
Row 2 Column X (Header = Skills 4) Horse;5
Row 2 Column Y (Header = Skills 5) Hamster;5
Row 2 Column Z (Header = Skills 6) Rabbit;10
Row 2 Column AA (Header = Skills 7) Rat;15
Row 2 Column AB (Header = Skills 8) Lion;67
Row 2 Column AC (Header = Skills 9) Tiger;30

E.g. for the same row after VBA has been applied.

Row 2 Column U (Header = Skills) Snake;99
Row 2 Column V (Header = Skills 2) Lion;67
Row 2 Column W (Header = Skills 3) Dog;30
Row 2 Column X (Header = Skills 4) Tiger;30
Row 2 Column Y (Header = Skills 5) Cat;20
Row 2 Column Z (Header = Skills 6) Rat;15
Row 2 Column AA (Header = Skills 7) Rabbit;10
Row 2 Column AB (Header = Skills 8) Hamster;5
Row 2 Column AC (Header = Skills 9) Horse;5

The cells in the other columns indicated above are to be ignored and not moved.

Notes

1. The cells that I would like to rearrange might change in future but they will always have the same headers Skills, Skills 2, Skills 3, Skills 4 up to Skills 9 as in example above.

1. Some of the rows only have text and no numbers within the cells that are to be sorted. However it is consistent - all cells have just text or all cells have text and number. These rows could either be ignored as I do not mind how these rows are sorted.

3.

Not vital but if possible (others will be using this) - before the vba is applied can a input box be created for the name of the sheet to be reorganized to be manually inputted. And also a new sheet created for the results. So essentially after VBA is applied there are now two sheets - a before and after

Many thanks in advance for anyone who has advice or can help as I am struggling!

Alan

[AlanB]

Hi,
Does anyone know if it possible to use VBA to sort something where both a number and text are in the same cell. I can then try and look further into this myself in order to find a solution.

Many thanks
Alan

[Paul_Hossler]

Probably do-able, but an example workbook with 5-10 rows of data will help

[AlanB]

Hi Paul,

Many thanks - Excel document attached.

Cheers

Alan

[AlanB]

Hi - I wanted to repost this query that I orginally asked back in Oct 2018. I was never able to find a solution in sorting the cells in the row from high to low. The problem has reared its head again so I would appreciate it if anyone is able to help.

Many thanks
Alan

[Artik]

We are dealing here with horizontal sorting, with obstacles
To sort such data, there is no alternative but to separate the data into two columns, sort and reconnect.
In the Macro steps sheet I showed what more or less does the proposed macro. An auxiliary sheet is used for sorting. On my computer, 40k records sorted about 20 seconds. Sorting is performed the longest (Step 3) using the built-in tool. Perhaps you could replace them with some other faster sorting algorithm.
Before starting the macro, copy the sheet to be sorted.

Artik

[Paul_Hossler]

What if there's no number?

Capture.JPG

[AlanB]

hmmm placed after lowest number in alphabetical order? This info won't be used as much as others so almost whatever is easiest.


Thanks
Alan

[Paul_Hossler]

try something like this

Option Explicit
Sub SortStuff()
    Dim rData As Range
    Dim v As Variant
    Dim r As Long, c As Long, i As Long, j As Long
    Dim s As String
    Dim sNewSheet As String
    
    
    Application.ScreenUpdating = False
    
    'make new name
    sNewSheet = ActiveSheet.Name & "-Sorted"
    
    'delete if it exists
    Application.DisplayAlerts = False
    On Error Resume Next
    Worksheets(sNewSheet).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    ActiveSheet.Copy after:=ActiveSheet
    ActiveSheet.Name = sNewSheet
    
    
    Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
    
    'get rid of empty strings
    Call rData.Replace(vbNullString, "###", xlWhole)
    Call rData.Replace("###", vbNullString, xlWhole)
    
    With rData
'        'make into 00000skill format
        For r = 2 To .Rows.Count
            For c = 21 To 29
                If Len(.Cells(r, c).Value) = 0 Then
                    .Cells(r, c).Value = "99999zzzzzzzzzz" '   force to end
                Else
                    v = Split(.Cells(r, c).Value, ";")
                    If UBound(v) = 1 Then
                        .Cells(r, c).Value = Format(v(1), "00000") & v(0)
                    Else
                        .Cells(r, c).Value = "00001" & v(0)
                    End If
                End If
            Next c
        Next r
        
        'sort each row, 10 cells
        For r = 2 To .Rows.Count
            v = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(.Cells(r, 21).Resize(1, 9).Value))
        
            'simple bubble sort
            For i = LBound(v) To UBound(v) - 1
                For j = i + 1 To UBound(v)
                    If v(i) > v(j) Then
                        s = v(i)
                        v(i) = v(j)
                        v(j) = s
                    End If
                Next j
            Next i
            
            .Cells(r, 21).Resize(1, 9).Value = v
        Next r
        
        'make into skill;n format
        For r = 2 To .Rows.Count
            For c = 21 To 29
                If .Cells(r, c).Value = "99999zzzzzzzzzz" Then
                    .Cells(r, c).Value = Empty
                Else
                    .Cells(r, c).Value = Right(.Cells(r, c).Value, Len(.Cells(r, c).Value) - 5) & ";" & Format(Left(.Cells(r, c).Value, 5), "0")
                End If
            Next c
        Next r
    End With

    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

[AlanB]

Artik, Paul - Many thanks for your help with this - I can confirm that they both worked and my problem solved. I will update the post as such.

Thank you so much.
Cheers
Alan