How Do I Sort Alpha Numerically?

Dazzawm

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,748
Office Version
  1. 365
Platform
  1. Windows
I have numbers in the format of CB1, CB2, CB11, CB23 etc etc. When I do a sort it will only sort like below

CB1
CB10
CB11
CB2

rather than

CB1
CB2
CB10 etc etc

How do I get round this please?
 
Sort by date Sort by votes
Hi Mick, it did work - sort of. It didn't sort them though as I needed in post 13. It put all the 1's together then 2's etc, rather than all the letters and their numbers i.e CA1, CA2 etc then CB1, CB2 etc.
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Although its interesting, You've moved the goalpost 4 times now. !!!!
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG07Apr51
[COLOR="Navy"]Dim[/COLOR] Ray
[COLOR="Navy"]Dim[/COLOR] i       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] j       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] jj      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ii      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Temp    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Lst     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oTx     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Dim[/COLOR] K
Lst = Cells("1", Columns.Count).End(xlToLeft).Column
Ray = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Resize(, Lst)


[COLOR="Navy"]For[/COLOR] i = 1 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] j = i To UBound(Ray, 1)
        jj = IIf(IsNumeric(Mid(Ray(j, 1), 2, 1)), 2, 3)
        ii = IIf(IsNumeric(Mid(Ray(i, 1), 2, 1)), 2, 3)
         [COLOR="Navy"]If[/COLOR] Left(Ray(j, 1), jj) < Left(Ray(i, 1), ii) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]For[/COLOR] Ac = 1 To Lst
                Temp = Ray(i, Ac)
                Ray(i, Ac) = Ray(j, Ac)
                Ray(j, Ac) = Temp
            [COLOR="Navy"]Next[/COLOR] Ac
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] j
[COLOR="Navy"]Next[/COLOR] i




[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
        jj = IIf(IsNumeric(Mid(Ray(n, 1), 2, 1)), 1, 2)
            oTx = Left(Ray(n, 1), jj)
            [COLOR="Navy"]If[/COLOR] Not .Exists(oTx) [COLOR="Navy"]Then[/COLOR]
                .Add oTx, Array(n, 0)
            [COLOR="Navy"]Else[/COLOR]
                Q = .Item(oTx)
                    Q(1) = n
                .Item(oTx) = Q
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR]


 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]For[/COLOR] i = .Item(K)(0) To .Item(K)(1)
        [COLOR="Navy"]For[/COLOR] j = i To .Item(K)(1)
            [COLOR="Navy"]If[/COLOR] Val(Mid(Ray(j, 1), Len(K) + 1)) < Val(Mid(Ray(i, 1), Len(K) + 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]For[/COLOR] Ac = 1 To Lst
                    Temp = Ray(i, Ac)
                    Ray(i, Ac) = Ray(j, Ac)
                    Ray(j, Ac) = Temp
                [COLOR="Navy"]Next[/COLOR] Ac
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] j
    [COLOR="Navy"]Next[/COLOR] i
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With


Range("A1").Resize(UBound(Ray), Lst) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Dazzawm said:
Now I have a box with Bad Val in it? Don't go to too much trouble I am sure Micks will do the job, besides I will need a code to sort all columns not just the first column. Thanks GTO.
Click to expand...

I believe that means that there are values being analyzed that do not start with a letter (or letters) and end with a number.
 
Upvote 0
MickG said:
Although its interesting, You've moved the goalpost 4 times now. !!!!
Regards Mick
Click to expand...

How have I? I think you read post 14 but not 13. Thanks I will try this code.
 
Upvote 0
MickG said:
Try this:-
Code: 
[COLOR=Navy]Sub[/COLOR] MG07Apr51
[COLOR=Navy]Dim[/COLOR] Ray
[COLOR=Navy]Dim[/COLOR] i       [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] j       [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] jj      [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] ii      [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Temp    [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] Lst     [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Ac      [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] n       [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] oTx     [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] Q
[COLOR=Navy]Dim[/COLOR] K
Lst = Cells("1", Columns.Count).End(xlToLeft).Column
Ray = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Resize(, Lst)


[COLOR=Navy]For[/COLOR] i = 1 To UBound(Ray, 1)
    [COLOR=Navy]For[/COLOR] j = i To UBound(Ray, 1)
        jj = IIf(IsNumeric(Mid(Ray(j, 1), 2, 1)), 2, 3)
        ii = IIf(IsNumeric(Mid(Ray(i, 1), 2, 1)), 2, 3)
         [COLOR=Navy]If[/COLOR] Left(Ray(j, 1), jj) < Left(Ray(i, 1), ii) [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]For[/COLOR] Ac = 1 To Lst
                Temp = Ray(i, Ac)
                Ray(i, Ac) = Ray(j, Ac)
                Ray(j, Ac) = Temp
            [COLOR=Navy]Next[/COLOR] Ac
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] j
[COLOR=Navy]Next[/COLOR] i




[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    [COLOR=Navy]For[/COLOR] n = 1 To UBound(Ray, 1)
        jj = IIf(IsNumeric(Mid(Ray(n, 1), 2, 1)), 1, 2)
            oTx = Left(Ray(n, 1), jj)
            [COLOR=Navy]If[/COLOR] Not .Exists(oTx) [COLOR=Navy]Then[/COLOR]
                .Add oTx, Array(n, 0)
            [COLOR=Navy]Else[/COLOR]
                Q = .Item(oTx)
                    Q(1) = n
                .Item(oTx) = Q
            [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR]


 [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
    [COLOR=Navy]For[/COLOR] i = .Item(K)(0) To .Item(K)(1)
        [COLOR=Navy]For[/COLOR] j = i To .Item(K)(1)
            [COLOR=Navy]If[/COLOR] Val(Mid(Ray(j, 1), Len(K) + 1)) < Val(Mid(Ray(i, 1), Len(K) + 1)) [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]For[/COLOR] Ac = 1 To Lst
                    Temp = Ray(i, Ac)
                    Ray(i, Ac) = Ray(j, Ac)
                    Ray(j, Ac) = Temp
                [COLOR=Navy]Next[/COLOR] Ac
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] j
    [COLOR=Navy]Next[/COLOR] i
[COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]End[/COLOR] With


Range("A1").Resize(UBound(Ray), Lst) = Ray
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

Hi Mick this code works great but I think it only caters for a 2 letter prefix. Can it be amended for any number of letters before the numbers please?
 
Last edited:
Upvote 0
Daz, I can't quickly see quite how that codes works (Its a long time ago !!), so I've written another one. At the moment its just for column "A", give it a try, if its OK, I'll add to cover other columns.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG11Jul55
[COLOR="Navy"]Dim[/COLOR] nStr  [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, Ray(), c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    num = GetDigits(Dn.Value)
    nStr = Left(Dn.Value, Len(Dn.Value) - Len(CStr(num)))
        [COLOR="Navy"]If[/COLOR] Not .Exists(nStr) [COLOR="Navy"]Then[/COLOR]
            ReDim Ray(0 To Rng.Count)
            Ray(0) = num
            .Add nStr, Array(Dn, Ray, 0)
        [COLOR="Navy"]Else[/COLOR]
          Q = .Item(nStr)
            [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
            Q(2) = Q(2) + 1
            Q(1)(Q(2)) = num
         .Item(nStr) = Q
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn

[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    .Item(K)(0).Value = Application.Transpose(.Item(K)(1))
    .Item(K)(0).Sort .Item(K)(0)(1)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] .Item(K)(0)
        Dn.Value = K & Dn.Value
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] K

[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Function GetDigits(strAlNum [COLOR="Navy"]As[/COLOR] String) [COLOR="Navy"]As[/COLOR] Variant
  [COLOR="Navy"]Dim[/COLOR] X [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
  [COLOR="Navy"]For[/COLOR] X = 1 To Len(strAlNum)
    [COLOR="Navy"]If[/COLOR] Mid(strAlNum, X, 1) Like "#" [COLOR="Navy"]Then[/COLOR] GetDigits = GetDigits & Mid(strAlNum, X, 1)
  [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] Function
Regards Mick
 
Last edited:
Upvote 0
UDF?

Code: 
Function PadNum(sInp As String, Optional iLen As Long = 1) As String
  ' shg 2003

  ' Expands numbers in a string to iLen characters for sorting; e.g.,
  '   PadNum("13A1U3", 2)    returns "13A01U03"
  '   PadNum("1.2.3.15", 3)  returns "001.002.003.015"

  ' Numbers are not shortened below their minimal representation:
  '   PadNum("1.123.2.3", 2) = "01.123.02.03"

  ' Returns unpadded values if iLen <= 1 or omitted
  '   PadNum("01.123.02.03") = "1.123.2.3"

  ' Digit strings longer that 15 digits are not modified, because
  ' formatting would cause loss of digits
  
  ' All characters other than digits 0-9 are returned as-is

  Dim sFmt          As String   ' format string
  Dim sChr          As String   ' a character in sInp
  Dim iChr          As Long     ' character index to sInp
  Dim sNum          As String   ' digit string from sInp

  sFmt = String(IIf(iLen < 1, 1, IIf(iLen > 15, 15, iLen)), "0")

  For iChr = 1 To Len(sInp) + 1   ' the +1 flushes a trailing number
    sChr = Mid$(sInp, iChr, 1)
    If sChr Like "#" Then
      sNum = sNum & sChr
    Else
      If Len(sNum) Then
        PadNum = PadNum & IIf(Len(sNum) <= 15, Format$(sNum, sFmt), sNum)
        sNum = vbNullString
      End If
      PadNum = PadNum & sChr
    End If
  Next iChr
End Function


A​
B​
C​
1​
Before​
Sort​
2​
C1C01B2: =PadNum(A2, 2)
3​
C10C10
4​
C11C11
5​
C12C12
6​
C13C13
7​
C14C14
8​
C15C15
9​
C16C16
10​
C17C17
11​
C18C18
12​
C19C19
13​
C2C02
14​
C3C03
15​
C4C04
16​
C5C05
17​
C6C06
18​
C7C07
19​
C8C08
20​
C9C09
21​
CB1CB01
22​
CB10CB10
23​
CB11CB11
24​
CB12CB12
25​
CB13CB13
26​
CB14CB14
27​
CB15CB15
28​
CB16CB16
29​
CB17CB17
30​
CB18CB18
31​
CB19CB19
32​
CB2CB02
33​
CB20CB20
34​
CB3CB03
35​
CB4CB04
36​
CB5CB05
37​
CB6CB06
38​
CB7CB07
39​
CB8CB08
40​
CB9CB09

Sort by the Sort column.
 
Last edited:
Upvote 0
MickG said:
Daz, I can't quickly see quite how that codes works (Its a long time ago !!), so I've written another one. At the moment its just for column "A", give it a try, if its OK, I'll add to cover other columns.
Code: 
[COLOR=Navy]Sub[/COLOR] MG11Jul55
[COLOR=Navy]Dim[/COLOR] nStr  [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] num [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Q [COLOR=Navy]As[/COLOR] Variant, Ray(), c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    num = GetDigits(Dn.Value)
    nStr = Left(Dn.Value, Len(Dn.Value) - Len(CStr(num)))
        [COLOR=Navy]If[/COLOR] Not .Exists(nStr) [COLOR=Navy]Then[/COLOR]
            ReDim Ray(0 To Rng.Count)
            Ray(0) = num
            .Add nStr, Array(Dn, Ray, 0)
        [COLOR=Navy]Else[/COLOR]
          Q = .Item(nStr)
            [COLOR=Navy]Set[/COLOR] Q(0) = Union(Q(0), Dn)
            Q(2) = Q(2) + 1
            Q(1)(Q(2)) = num
         .Item(nStr) = Q
        [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn

[COLOR=Navy]Dim[/COLOR] K [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
    .Item(K)(0).Value = Application.Transpose(.Item(K)(1))
    .Item(K)(0).Sort .Item(K)(0)(1)
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] .Item(K)(0)
        Dn.Value = K & Dn.Value
    [COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]Next[/COLOR] K

[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Function GetDigits(strAlNum [COLOR=Navy]As[/COLOR] String) [COLOR=Navy]As[/COLOR] Variant
  [COLOR=Navy]Dim[/COLOR] X [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
  [COLOR=Navy]For[/COLOR] X = 1 To Len(strAlNum)
    [COLOR=Navy]If[/COLOR] Mid(strAlNum, X, 1) Like "#" [COLOR=Navy]Then[/COLOR] GetDigits = GetDigits & Mid(strAlNum, X, 1)
  [COLOR=Navy]Next[/COLOR]
[COLOR=Navy]End[/COLOR] Function
Regards Mick
Click to expand...

Thanks Mick. I thought you may be able to read through the code like I would the sports pages, sorry about that!

I run the code but got a visual basic error 400

Sheet 1 Before Code

Excel 2010
A
2FASS2400
3FASS4371
4FASS4169
5FASS059
6FASS1282
7FASS505
8FASS596
9FASS6092
10FASS2861
11FASS4550
12FASS6388
13FASS6393

<colgroup><col style="width: 25pxpx" https:="" www.mrexcel.com="" forum="" usertag.php?do="list&action=hash&hash=DAE7F5"" target="_blank"></colgroup><colgroup><col></colgroup><thead>
</thead><tbody>
</tbody>
sheet1​



Sheet 1 After Code

Excel 2010
A
22400
34371
44169
5FASS059
62400
72400
82400
92400
102400
112400
122400
132400

<colgroup><col style="width: 25pxpx" https:="" www.mrexcel.com="" forum="" usertag.php?do="list&action=hash&hash=DAE7F5"" target="_blank"></colgroup><colgroup><col></colgroup><thead>
</thead><tbody>
</tbody>
sheet1​
 
Last edited:
Upvote 0
Its because you have the number part of the Data starting with a "0", (FASS059) is that necessary .???
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Sorting part numbers based on ascending order and also putting "a" part numbers at top
Replies
4
Views
91
myall_blues
myall_blues
T
  • Question
How to ignore text values in a simple formula
Replies
3
Views
103
Fluff
Fluff
Keebler
  • Solved
clean code
5 6 7
Replies
66
Views
1K
Keebler
Keebler
Z
  • Question
VBA macro with ActiveWorkbook not working from Personal.xlsb
Replies
7
Views
106
Zand
Z
K
  • Solved
How to fix this database?
Replies
5
Views
103
Alex Blakenburg
A

Forum statistics

Threads
1,215,444
Messages
6,124,891
Members
449,194
Latest member
JayEggleton

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top