PDA

View Full Version : [SOLVED] Need help- Sort columns within rows numerically. Cells contain text as well as number



AlanB
10-14-2018, 01:37 PM
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



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.





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
10-16-2018, 11:21 AM
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
10-16-2018, 03:44 PM
Probably do-able, but an example workbook with 5-10 rows of data will help

AlanB
10-17-2018, 02:28 AM
Hi Paul,

Many thanks - Excel document attached.

Cheers

Alan

AlanB
07-16-2019, 01:15 AM
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
07-16-2019, 08:45 PM
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
07-17-2019, 10:09 AM
What if there's no number?

24617

AlanB
07-17-2019, 10:19 AM
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
07-17-2019, 10:30 AM
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.Trans pose(.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
07-17-2019, 11:25 AM
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