# Thread: Sorting based on letter, and then on number

1. ## Sorting based on letter, and then on number

Hi all,

I have a column of values with each row in that column composed of 1 to 3 letters, and then a number, with the length of this number ranging from 1 to 5 digits.

The letters all belong in a group, (e.g. AA, B, C, CB, J, T) and so need to be grouped together when sorting, and the numbers then are to increase sequentially.

Below is a table with my intended input and desired output.

 Input Output AA1 AA1 T4 B5 T1 C27 B5 CB5 J23 CB12 J19 J19 C27 J23 CB12 T1 CB5 T4

Is this something that can be achieved with VBA?

If so, any guidance would be greatly appreciated Cheers,
enjam  Reply With Quote

2. Use This Code if it is help full to you or not

```Sub Sorting()
Dim InSheet As Worksheet
Set InSheet = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Integer
LastRow = InSheet.Cells(Rows.Count, "A").End(xlUp).Row

With InSheet.Sort  ' sort data from A to Z
.SetRange InSheet.Range("A1:A9" & LastRow)
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub```  Reply With Quote  Reply With Quote

4. This seems to match what you wanted

You might have to change the way the logic is used since I used a driver sub and the range to sort is hard coded

It basically takes the cells in the sort range, reformats in a format to sort, sorts, and then changes the cell back to the original format

```Option Explicit

Sub drv()

Call LetterNumberSort(Range("A2:A10"))

End Sub

' composed of 1 to 3 letters, and then a number, with the length of this number ranging from 1 to 5 digits.
Sub LetterNumberSort(r As Range)
Dim c As Range
Dim i As Long
Dim s As String

With r

For Each c In .Cells
c.Value = pvtFormatToSort(c.Value)
Next

With .Parent.Sort
.SortFields.Clear
.SetRange r
.MatchCase = True
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

For Each c In .Cells
c.Value = pvtFormatToDisplay(c.Value)
Next
End With
End Sub

Private Function pvtFormatToSort(s As String) As String
Dim s1 As String, s2 As String, s3 As String

s1 = Trim(UCase(s))

If s1 Like "[A-Za-z]#*" Then
s2 = Left(s1, 1) & "00"
s3 = Right("00000" & Right(s1, Len(s1) - 1), 5)

ElseIf s1 Like "[A-Za-z][A-Za-z]#*" Then
s2 = Left(s1, 2) & "0"
s3 = Right("00000" & Right(s1, Len(s1) - 2), 5)

ElseIf s1 Like "[A-Za-z][A-Za-z][A-Za-z]#*" Then
s2 = Left(s1, 3)
s3 = Right("00000" & Right(s1, Len(s1) - 3), 5)
End If

pvtFormatToSort = s2 & s3
End Function

Private Function pvtFormatToDisplay(s As String) As String
Dim s1 As String, s2 As String
Dim i As Long

If s Like "[A-Za-z]#*" Then
i = 2
ElseIf s Like "[A-Za-z][A-Za-z]#*" Then
i = 3
ElseIf s Like "[A-Za-z][A-Za-z][A-Za-z]#*" Then
i = 4
End If

s1 = Left(s, i - 1)

Do While Mid(s, i, 1) = 0
i = i + 1
Loop

s2 = Right(s, Len(s) - i + 1)

pvtFormatToDisplay = s1 & s2
End Function```  Reply With Quote

5. Thanks Paul, will test this code out on Monday and get back to you.

Cheers,
enjam  Reply With Quote

6. Slightly more efficient version

```Option Explicit

Sub drv()

Call LetterNumberSort(Range("A2:A10"))

End Sub

' composed of 1 to 3 letters, and then a number, with the length of this number ranging from 1 to 5 digits.
Sub LetterNumberSort(r As Range)
Dim c As Range
Dim i As Long
Dim s As String

With r
For Each c In .Cells
Call pvtFormatToSort(c)
Next

With .Parent.Sort
.SortFields.Clear
.SetRange r
.MatchCase = True
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

For Each c In .Cells
Call pvtFormatToDisplay(c)
Next
End With
End Sub

Private Sub pvtFormatToSort(r As Range)
Dim s1 As String, s2 As String, s3 As String

s1 = Trim(UCase(r.Value))

If s1 Like "[A-Z]#*" Then
s2 = Left(s1, 1) & "00"
s3 = Right("00000" & Right(s1, Len(s1) - 1), 5)

ElseIf s1 Like "[A-Z][A-Z]#*" Then
s2 = Left(s1, 2) & "0"
s3 = Right("00000" & Right(s1, Len(s1) - 2), 5)

ElseIf s1 Like "[A-Z][A-Z][A-Z]#*" Then
s2 = Left(s1, 3)
s3 = Right("00000" & Right(s1, Len(s1) - 3), 5)
End If

r.Value = s2 & s3
End Sub

Private Sub pvtFormatToDisplay(r As Range)
Dim s1 As String, s2 As String, s3 As String
Dim i As Long

s1 = r.Value

If s1 Like "[A-Z]#*" Then
i = 2
ElseIf s1 Like "[A-Z][A-Z]#*" Then
i = 3
ElseIf s1 Like "[A-Z][A-Z][A-Z]#*" Then
i = 4
End If

s2 = Left(s1, i - 1)

Do While Mid(s1, i, 1) = 0
i = i + 1
Loop

s3 = Right(s1, Len(s1) - i + 1)

r.Value = s2 & s3
End Sub```  Reply With Quote

7. If you're happy for the output to be a separate range from your input (rather than just sorting your input in situ) see Power Query solution table in colmn D of the attached where you right-click that table and choose Refresh to update.  Reply With Quote

8. Thank you Paul, that code works just as intended. I'm applying on a range that's quite a bit longer (280,000 rows); it takes a while, but does the job Pascal, thanks also for your input. Unfortunately I can't leverage the performance advantage of PowerQuery here as the sorting needs to be done in situ.  Reply With Quote

9. I'd suggest to use VBA:

```Sub M_snb()
sn = Sheet1.Cells(1).CurrentRegion.Columns(1)

With GetObject("new:{00000535-0000-0010-8000-00AA006D2EA4}")
.Fields.Append "S", 129, 3
.Fields.Append "N", 5
.Open

For j = 1 To UBound(sn)
.Fields("N") = StrReverse(Val(StrReverse(sn(j, 1))))
.Fields("S") = Replace(sn(j, 1), .Fields("N"), "")
.Update
Next
.Sort = "S,N"

MsgBox Replace(Replace(.getstring, vbTab, ""), " ", "")
End With
End Sub```
or

```Sub M_snb()
sn = Sheet1.Cells(1).CurrentRegion.Columns(1)

With GetObject("new:{00000535-0000-0010-8000-00AA006D2EA4}")
.Fields.Append "S", 129, 3
.Fields.Append "N", 5
.Open

For j = 1 To UBound(sn)
.Fields("N") = StrReverse(Val(StrReverse(sn(j, 1))))
.Fields("S") = Replace(sn(j, 1), .Fields("N"), "")
.Update
Next
.Sort = "S,N"

sp = .getrows
For j = 0 To UBound(sp, 2)
sn(j + 1, 1) = Trim(sp(0, j)) & sp(1, j)
Next

Sheet1.Cells(1).CurrentRegion.Columns(1) = sn
End With
End Sub```  Reply With Quote

10. Originally Posted by enjam Pascal, thanks also for your input. Unfortunately I can't use the performance advantage of PowerQuery here as the sorting needs to be done in situ.
That's possible with Power Query and 2 lines of VBA. It takes 20 seconds here to sort 280,000 records in situ. Originally Posted by enjam Thank you Paul, that code works just as intended. I'm applying on a range that's quite a bit longer (280,000 rows); it takes a while, but does the job :)
Paul's code does take a while to complete with 280,000 records; I saw it was going to take some time so I left it running and went and chopped down a tree and planted 4 in its place. On returning I found it took 2.5 hours.
Paul's code takes a long time to execute because there's no Application.ScreenUpdating = False, but more importantly because it writes and reads to the sheet so many times.
In the attached, I've applied a few tweaks to Paul's code to reduce the number of read/writes to the sheet to just 4.
This took the time down to less than 4 seconds for 280,000 records, which is much faster than Power Query.

There is another difference I noticed; if you have values with leading zeroes in the numeric part like CB002, this get's reduced to CB2, which the PQ offering doesn't change. It would only need a bit more of a tweak to Paul's code to stop this happening.  Reply With Quote

11. @snb,

For me, your both VBA code, gave error. eroare.jpg
Highlight this line:
.Fields("S") = Replace(sn(j, 1), .Fields("N"), "")  Reply With Quote

12. Originally Posted by enjam Thank you Paul, that code works just as intended. I'm applying on a range that's quite a bit longer (280,000 rows); it takes a while, but does the job Sorry, if I had known you were talking about 280K entries, I would have used arrays (like I think P45cal did)

My fault was using a IMHO more straight-forward approach that I thought would be easier for you to integrate

If it still seems too slow, come on back, but p45cal's and snb's should work fine  Reply With Quote

13. Originally Posted by Tom Jones @snb,
Highlight this line:
.Fields("S") = Replace(sn(j, 1), .Fields("N"), "")
I think it's to do with the original ending in a zero. In the following, zzz is your recordset object:
```?sn(j, 1)
FVR25180
?StrReverse(sn(j, 1))
08152RVF
?Val(StrReverse(sn(j, 1)))
8152
?StrReverse(Val(StrReverse(sn(j, 1))))
2518
?zzz.Fields("N")
2518
?Replace(sn(j, 1), zzz.Fields("N"), "")
FVR0```
I put it in code tags to try to preserve spaces/invisible characters.
Although the last command produces a string, it's the execution of:
.Fields("S") = Replace(sn(j, 1), .Fields("N"), "")
which throws an error.
Doing a Val on a string starting with zero, the zero is ignored.
Still don't know why it throws an error though…

edit: could it be because it's trying to put more than a 3-character string in a field with a defined size of 3?  Reply With Quote

14. In that case:

```Sub M_snb()
sn = Sheet1.Cells(1).CurrentRegion.Columns(1)

With GetObject("new:{00000535-0000-0010-8000-00AA006D2EA4}")
.Fields.Append "S", 129, 3
.Fields.Append "N", 5
.Open

For j = 1 To UBound(sn)
y = StrReverse(Val(StrReverse(sn(j, 1))))
n = Left(sn(j, 1), InStr(sn(j, 1), y) - 1)
y = y * 10 ^ (Len(sn(j, 1)) - Len(y) - Len(n))
.Fields("S") = n
.Fields("N") = y
.Update
Next
.Sort = "S,N"

sp = .getrows
For j = 0 To UBound(sp, 2)
sn(j + 1, 1) = Trim(sp(0, j)) & sp(1, j)
Next

Sheet1.Cells(1).CurrentRegion.Columns(1) = sn
End With
End Sub```  Reply With Quote

15. Hi snb, thanks for your help, your revised VBA code also have me an error.

Apologies Paul for not specifying the number of rows; I will be more mindful of this in future posts.

Pascal thank you very much, that code works just as intended, and rapidly too. Is it possible to have a table 14 columns wide (and 280,000 rows long) to be sorted in this order, based on Column A?  Reply With Quote

16. Apologies Paul for not specifying the number of rows; I will be more mindful of this in future posts.
No problem - my personal first approach is to go with a simple approach, even if it's not as efficient as others. For 1000+ rows, I doubt there would be a perceptible wall clock time difference

280k rows requires a more efficient approach as P45cal and snb have said

I used P45cal's macro and 'generalized' it a bit to sort the block of data (.CurrentRegion) by the first column, and I assumed that you had headers

For testing in the attached (since the run time issue has been fixed) I just used a dozen rows and 14 columns, so try it with your real data

```Option Explicit

Sub drv()
Call LetterNumberSort(ActiveSheet.Cells(1, 1).CurrentRegion)
End Sub

' composed of 1 to 3 letters, and then a number, with the length of this number ranging from 1 to 5 digits.
Sub LetterNumberSort(r As Range)
Dim i As Long
Dim aryValues As Variant
Dim s As String
Dim r1 As Range

With r
Set r1 = .Cells(2, 1).Resize(.Rows.Count - 1, .Columns.Count)

aryValues = .Columns(1).Value

For i = 2 To UBound(aryValues, 1)
Call pvtFormatToSort(aryValues(i, 1))
Next

.Columns(1).Value = aryValues

With .Parent.Sort
.SortFields.Clear
.SetRange r
.MatchCase = True
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

aryValues = .Columns(1).Value

For i = 2 To UBound(aryValues)
Call pvtFormatToDisplay(aryValues(i, 1))
Next

.Columns(1).Value = aryValues
End With
End Sub

'1. objects are always passed ByRef
'2. r should be Dim-ed as a Range since it is a Range, and not a Variant
'3. I originally had these as Functions, but that way forces VBA to make copies of the strings
Private Sub pvtFormatToSort(r As Range)
Dim s1 As String, s2 As String, s3 As String

s1 = Trim(UCase(r))

If s1 Like "[A-Z]#*" Then
s2 = Left(s1, 1) & "00"
s3 = Right("00000" & Right(s1, Len(s1) - 1), 5)

ElseIf s1 Like "[A-Z][A-Z]#*" Then
s2 = Left(s1, 2) & "0"
s3 = Right("00000" & Right(s1, Len(s1) - 2), 5)

ElseIf s1 Like "[A-Z][A-Z][A-Z]#*" Then
s2 = Left(s1, 3)
s3 = Right("00000" & Right(s1, Len(s1) - 3), 5)
End If

r = s2 & s3
End Sub

Private Sub pvtFormatToDisplay(r As Range)
Dim s1 As String, s2 As String, s3 As String
Dim i As Long

s1 = r

If s1 Like "[A-Z]#*" Then
i = 2
ElseIf s1 Like "[A-Z][A-Z]#*" Then
i = 3
ElseIf s1 Like "[A-Z][A-Z][A-Z]#*" Then
i = 4
End If

s2 = Left(s1, i - 1)

Do While Mid(s1, i, 1) = 0
i = i + 1
Loop

s3 = Right(s1, Len(s1) - i + 1)

r = s2 & s3
End Sub```  Reply With Quote

17. Are you always so lazy ?
Why don't you mention the 'error' ?
Why don't you indicate in which line the 'error' occurs ?
Why don't try to find out what could cause the 'problem'?
Why don't you even post a sample workbook ?
How can we know in which workbook you will apply the macro?
If you use this code in PH's sample workbook you will see that it will ignore the column label, that obviously has no number in it.

```Sub M_snb()
sn = Sheet1.Columns(1).SpecialCells(2).Offset(1).SpecialCells(2)

With GetObject("new:{00000535-0000-0010-8000-00AA006D2EA4}")
.Fields.Append "S", 129, 3
.Fields.Append "N", 5
.Open

For j = 1 To UBound(sn)
y = StrReverse(Val(StrReverse(sn(j, 1))))
n = Left(sn(j, 1), InStr(sn(j, 1), y) - 1)
y = y * 10 ^ (Len(sn(j, 1)) - Len(y) - Len(n))
.Fields("S") = n
.Fields("N") = y
.Update
Next
.Sort = "S,N"

sp = .getrows
For j = 0 To UBound(sp, 2)
sn(j + 1, 1) = Trim(sp(0, j)) & sp(1, j)
Next

Sheet1.Columns(1).SpecialCells(2).Offset(1).SpecialCells(2) = sn
End With
End Sub```  Reply With Quote

18. Very sorry snb, I responded to these posts during the limited time I had during lunchbreak and can appreciate your frustration over the lack of detail in my response.

I have tested your code on PH's workbook and can confirm that it produces the desired output. Thank you.  Reply With Quote

19. Originally Posted by Paul_Hossler '1. objects are always passed ByRef
'2. r should be Dim-ed as a Range since it is a Range, and not a Variant
'3. I originally had these as Functions, but that way forces VBA to make copies of the strings
Paul,
you're right about point 1, my ByRef was superfluous.
About point 2 I'm not so sure. The r in the pvtFormatToSort sub was not meant to be a range but a value/member in the aryValues array. The r in that sub is a different r from that in the LetterNumberSort sub (scope and all that). I tried running your code and was immediately met with a ByRef argument type mismatch error, which I'm nigh on certain is because you've Dim-med it as a range.
Re. point 3, I'm going to have an explore of making them into functions, but later…  Reply With Quote

20. Originally Posted by snb Why don't you even post a sample workbook ?
Exactly.  Reply With Quote

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•