Sorting Alphanumeric column character by character using excel VBA

S

seesrini

New Member
Joined
Nov 23, 2012
Messages
3
Hi All

There is a Alphanumeric column in excel which needs to be sorted according the character type.

Example

Column A
YOU56Y
YOUR6U
5YOUGH
2RTEIO
BHY67S

During sorting the column, the prefernce should be given to alphabets over numbers. Both the alphabets and numbers needs to be in ascending order. The columns needs to be sorted character by character.

The output of the above column should be

Column A
BHY67S
YOUR6U
YOU56Y
2RTEIO
5YOUGH

If we look at the output, the data YOUR6U was given prefernce over YOU56Y as the first three characters of the data were same. When moving on to the fourth character R is given prefernce over 5.

Thanks
Vasan
​
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
Try this (untested) on a copy of your data. Assumes data begin in A2.
Code: 
Sub SortAlphasFirst()
Dim lR As Long, R As Range, vA As Variant
lR = Range("A" & Rows.Count).End(xlUp).Row
Set R = Range("A2", "A" & lR)
vA = R.Value
'First cut - standard sort ascending
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    For j = i + 1 To UBound(vA, 1)
        If vA(i, 1) > vA(j, 1) Then
            temp = vA(i, 1)
            vA(i, 1) = vA(j, 1)
            vA(j, 1) = temp
        End If
    Next j
Next i
'2nd cut - sort by character giving alphas preference
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    For k = 1 To Len(vA(i, 1))
        If Mid(vA(i, 1), k, 1) Like "#" Then
            For j = i + 1 To UBound(vA, 1)
                If Not IsNumeric(Mid(vA(j, 1), 1, 1)) Then
                    temp = vA(i, 1)
                    vA(i, 1) = vA(j, 1)
                    vA(j, 1) = temp
                    Exit For
                End If
            Next j
        End If
    Next k
Next i
'3rd cut
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    For j = i + 1 To UBound(vA, 1)
        For k = 1 To WorksheetFunction.Min(Len(vA(i, 1)), Len(vA(j, 1)))
            If Mid(vA(i, 1), k, 1) Like "[A-Z]" And Mid(vA(j, 1), _
                k, 1) Like "[A-Z]" Or Mid(vA(i, 1), k, 1) Like "#" _
                And Mid(vA(j, 1), k, 1) Like "#" Then
                    If Mid(vA(i, 1), k, 1) > Mid(vA(j, 1), k, 1) Then
                        temp = vA(i, 1)
                        vA(i, 1) = vA(j, 1)
                        vA(j, 1) = temp
                        Exit For
                    ElseIf Mid(vA(i, 1), k, 1) < Mid(vA(j, 1), k, 1) Then
                        Exit For
                    ElseIf Mid(vA(i, 1), k, 1) = Mid(vA(j, 1), k, 1) Then
                        'do  nothing
                    End If
            End If
        Next k
    Next j
Next i
R.Value = vA
End Sub
 
Upvote 0
Hi all,

Another approach that I believe would work...

Code: 
Sub Sort_Special()
    Dim i As Long
    With Selection
        For i = 0 To 9
            .Replace What:=i, Replacement:="ZZZZZ" & i, LookAt:=xlPart, MatchCase:=False
        Next i
        .Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
        For i = 0 To 9
            .Replace What:="ZZZZZ", Replacement:="", LookAt:=xlPart, MatchCase:=False
        Next i
    End With
End Sub
 
Upvote 0
JoeMo said:
Try this (untested) on a copy of your data. Assumes data begin in A2.
Code: 
Sub SortAlphasFirst()
Dim lR As Long, R As Range, vA As Variant
lR = Range("A" & Rows.Count).End(xlUp).Row
Set R = Range("A2", "A" & lR)
vA = R.Value
'First cut - standard sort ascending
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    For j = i + 1 To UBound(vA, 1)
        If vA(i, 1) > vA(j, 1) Then
            temp = vA(i, 1)
            vA(i, 1) = vA(j, 1)
            vA(j, 1) = temp
        End If
    Next j
Next i
'2nd cut - sort by character giving alphas preference
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    For k = 1 To Len(vA(i, 1))
        If Mid(vA(i, 1), k, 1) Like "#" Then
            For j = i + 1 To UBound(vA, 1)
                If Not IsNumeric(Mid(vA(j, 1), 1, 1)) Then
                    temp = vA(i, 1)
                    vA(i, 1) = vA(j, 1)
                    vA(j, 1) = temp
                    Exit For
                End If
            Next j
        End If
    Next k
Next i
'3rd cut
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    For j = i + 1 To UBound(vA, 1)
        For k = 1 To WorksheetFunction.Min(Len(vA(i, 1)), Len(vA(j, 1)))
            If Mid(vA(i, 1), k, 1) Like "[A-Z]" And Mid(vA(j, 1), _
                k, 1) Like "[A-Z]" Or Mid(vA(i, 1), k, 1) Like "#" _
                And Mid(vA(j, 1), k, 1) Like "#" Then
                    If Mid(vA(i, 1), k, 1) > Mid(vA(j, 1), k, 1) Then
                        temp = vA(i, 1)
                        vA(i, 1) = vA(j, 1)
                        vA(j, 1) = temp
                        Exit For
                    ElseIf Mid(vA(i, 1), k, 1) < Mid(vA(j, 1), k, 1) Then
                        Exit For
                    ElseIf Mid(vA(i, 1), k, 1) = Mid(vA(j, 1), k, 1) Then
                        'do  nothing
                    End If
            End If
        Next k
    Next j
Next i
R.Value = vA
End Sub
Click to expand...
The code I posted works for the data posted, but doesn't stand up to a more rigorous test. Here's a modification:
Code: 
Sub SortAlphasFirst2()
Dim lR As Long, R As Range, vA As Variant
lR = Range("A" & Rows.Count).End(xlUp).Row
Set R = Range("A2", "A" & lR)
vA = R.Value
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    For j = i + 1 To UBound(vA, 1)
        For k = 1 To WorksheetFunction.Min(Len(vA(i, 1)), Len(vA(j, 1)))
            If Mid(vA(i, 1), k, 1) Like "[A-Z]" And Mid(vA(j, 1), k, 1) Like "[A-Z]" Then
                If Mid(vA(i, 1), k, 1) > Mid(vA(j, 1), k, 1) Then
                    temp = vA(i, 1)
                    vA(i, 1) = vA(j, 1)
                    vA(j, 1) = temp
                    Exit For
                ElseIf Mid(vA(i, 1), k, 1) < Mid(vA(j, 1), k, 1) Then
                    Exit For
                End If
            ElseIf Mid(vA(i, 1), k, 1) Like "#" And Mid(vA(j, 1), k, 1) Like "#" Then
                If Mid(vA(i, 1), k, 1) > Mid(vA(j, 1), k, 1) Then
                    temp = vA(i, 1)
                    vA(i, 1) = vA(j, 1)
                    vA(j, 1) = temp
                    Exit For
                ElseIf Mid(vA(i, 1), k, 1) < Mid(vA(j, 1), k, 1) Then
                    Exit For
                End If
            ElseIf Mid(vA(i, 1), k, 1) Like "#" And Mid(vA(j, 1), k, 1) Like "[A-Z]" Then
                temp = vA(i, 1)
                vA(i, 1) = vA(j, 1)
                vA(j, 1) = temp
                Exit For
            ElseIf Mid(vA(i, 1), k, 1) Like "[A-Z]" And Mid(vA(j, 1), k, 1) Like "#" Then
                Exit For
            End If
        Next k
    Next j
Next i
R.Value = vA
End Sub
 
Upvote 0
Jerry,

This is very close to working for me but after running that macro I still having problems with an example such as:

CP1403
CP1404
CP1405
CP818
CP819
CP830
CP831

(this is part of a much larger data sheet that includes entries such as an alpha prefix then numeric suffix, all numeric, numeric prefix with an alpha suffix, and an alpha prefix, numeric body, alpha suffix.)

With the all numeric and also numeric prefix with alpha suffix examples it also is not in correct alphanumeric sequence such as:

274842
274843
274844
274845
274846
274847
32583
641288A
641316A
641317A
641318A
641319A
641320A
641321A
641322A
641333A
641345A
641346A
641347A
641348A
641359A
641660A
641663A
641664A
641665A
641666A
641667A
641668A
641669A
641671A
641672A
641712A
64315A
64469A
64562A


Is there a way to get this work? Thanks for your help.
 
Upvote 0
I would like it to appear:

CP818
CP819
CP830
CP831
CP1403
CP1404
CP1405
32583
274842
274843
274844
274845
274846
274847
64315A
64469A
64562A
641288A
641316A
641317A
641318A
641319A
641320A
641321A
641322A
641333A
641345A
641346A
641347A
641348A
641359A
641660A
641663A
641664A
641665A
641666A
641667A
641668A
641669A
641671A
641672A
641712A
 
Last edited:
Upvote 0
mfast said:
I would like it to appear:

CP818
CP819
CP830
CP831
CP1403
CP1404
CP1405
32583
274842
274843
274844
274845
274846
274847
64315A
64469A
64562A
641288A
641316A
641317A
641318A
641319A
641320A
641321A
641322A
641333A
641345A
641346A
641347A
641348A
641359A
641660A
641663A
641664A
641665A
641666A
641667A
641668A
641669A
641671A
641672A
641712A
Click to expand...

hi mfast,

have you had any luck with this in the end? I have a similar list to sort and was hoping to find an answer.
Thanks
 
Upvote 0
val_rucarean said:
hi mfast,

have you had any luck with this in the end? I have a similar list to sort and was hoping to find an answer.
Thanks
Click to expand...


I have kind of giving up..I have found that using my vendors sequence has worked best for me right now. I will probably revisit this shortly when I have some free time to throw at it.

Post here if you find something good. Thanks!
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
VBA macro for removing entire alphabet some special characters
Replies
1
Views
303
BobMaccaroni
B
E
  • Solved
Sorting Alphanumeric values in excel based on the Numerical Value
Replies
8
Views
432
EAG1
E
S
  • Question
Vba - generate random alphanumeric strings based on user input
Replies
1
Views
254
DanteAmor
DanteAmor
Keebler
  • Solved
adding sort to a complicated array of rabbit holes and ...
2
Replies
12
Views
431
Keebler
Keebler
M
  • Question
Sorting part numbers based on ascending order and also putting "a" part numbers at top
Replies
4
Views
168
myall_blues
myall_blues

Forum statistics

Threads
1,216,373
Messages
6,130,238
Members
449,568
Latest member
mwl_y

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