Sort By Excel Alphanumeric

Question

I have an excel sheet that I need to sort by an alphanumeric column. I can currently do this, but it's an ugly method and I want to have a vba macro to do this instead. It is numbers 3-22 and letters A-Z, currently I can only get vba to sort it 3-22 and it ignores the alphabetic portion. I need 3(A-Z) then 4(A-Z) etc and it needs to sort the whole sheet.

Currently I can accomplish this as follows: Make two new columns, first one

=IF(LEN(A4)=2,"0"&LEFT(A4,1),LEFT(A4,2))

the "0" is necessary to allow excel to see the new split number as a number and allows me to process both single and double digit numbers.

Second column:

=RIGHT(A3,1) 

this works as I always have the letter as the second digit. I then have to sort by column B then sort by C. So I am using the GUI to "sort by then".

I would like a macro that will automate the GUI clicks and formula input I mentioned above

I recorded a macro to do it and this is what I got:

Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C3").Select
ActiveCell.FormulaR1C1 = _
    "=IF(LEN(RC[-1])=2,""0""&LEFT(RC[-1],1),LEFT(RC[-1],2))"
Range("B3").Select
Selection.End(xlDown).Select
Range("C162").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Range("D3").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-2],1)"
Range("C3").Select
Selection.End(xlDown).Select
Range("D162").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Range("A1:E162").Select
Range("D162").Activate
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("C1:C162" _
    ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("D1:D162" _
    ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A1:E162")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

I would really like this to be cleaner so I can sort the data sheet by the alphanumeric column so I get 1(A-Z) then 2 (A-Z). Ideal output: 1A 2B 3C 2A 2B 2C etc

Answer 1

To use this example, you'll have to grab three routines from Chip Pearson's website. Create a new empty module in your VBA Editor and paste in the routines SortDictionary (at the bottom of the page), QSortInPlace, and QSortCompare. Whenever I'm doing any kind of sorting, this is my go-to library for something I know will work.

To sort your data, you have to separate and separately sort both the numbers and the letters. This example assumes that there is one number (multiple characters) and one letter (single character) in the cell. My test data is

7C
18F
22K
7Q
12G
17Q
21I
15F
13D
20U
11A
11W
14M
10Q
4B
20W
12K
19R
12Y
13Q
3Y
18J
9J
6P
11U

Because there could be (and are, in the test data) a single number appearing multiple times with (possibly) different letters, you have to create some sort of collection of all the numbers and associate all the possible letters that may exist with it. Look at the number 11 in the list, the entries include 11A, 11W, and 11U. In my example, I'm creating a Dictionary where an entry for 11 is added and the list of letters is associated with it A,W,U.

Building up the resulting array then just uses the sorted numbers, and pulls out the (potential) list of letters for each number and sorts the letters and adds it to the results.

Option Explicit

Sub test()
    SortSpecial Range("A1:A25")
End Sub

Sub SortSpecial(ByRef thisArea As Range)
    Dim numberPart As String
    Dim letterPart As String

    '--- build a Dictionary for the initial organization
    Dim list As Dictionary
    Set list = New Dictionary

    Dim cell As Range
    For Each cell In thisArea
        '--- the letter is always the last single character
        letterPart = Right$(cell.Value, 1)
        numberPart = Left$(cell.Value, Len(cell.Value) - 1)
        If list.Exists(numberPart) Then
            '--- add the letter to the list
            list(numberPart) = list(numberPart) & "," & letterPart
        Else
            list.Add numberPart, letterPart
        End If
    Next cell

    SortDictionary list, SortByKey:=True

    '--- now create an array for the results
    Dim i As Long
    Dim j As Long
    Dim number As Variant
    Dim lastNumber As Long
    Dim results As Variant
    ReDim results(1 To thisArea.Rows.Count, 1 To 1)
    i = 1
    For Each number In list
        Dim letters() As String
        letters = Split(list(number), ",")
        If UBound(letters) > LBound(letters) Then
            If Not QSortInPlace(letters) Then
                MsgBox "error sorting the letters!"
                Exit Sub
            End If
        End If
        For j = LBound(letters) To UBound(letters)
            results(i, 1) = number & letters(j)
            i = i + 1
        Next j
    Next number

    '--- put the results back on the sheet
    thisArea = results
End Sub