PDA

View Full Version : Sorting Alphanumeric column character by character



srinivasan05
12-03-2012, 11:06 AM
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

mikerickson
12-03-2012, 12:22 PM
If all your strings are 6 charecters long, you could make a helper column with
=SUMPRODUCT((CODE(UPPER(MID(A1,{1,2,3,4,5,6},1)))-49+(50*(MID(A1,{1,2,3,4,5,6},1)<"A")))*100^{0,1,2,3,4,5})

and sort on that.

CodeNinja
12-03-2012, 12:43 PM
If you want to use VBA to accomplish this... you could use something like the following code... You would have to change sheet2 to whatever sheet you were using etc...

Sub testSort()
Dim sCellData As String
Dim aTempRow As Variant
Dim iCharPos As Integer
Dim lRow As Long
Dim lThisCell As Long
Dim bGreaterLessthan As Boolean

For lThisCell = 2 To Sheet1.range("A65536").End(xlUp).Row - 1
For lRow = lThisCell + 1 To Sheet2.range("A65536").End(xlUp).Row
bGreaterLessthan = False
iCharPos = 1
sCellData = Sheet2.Cells(lThisCell, 1)
While bGreaterLessthan = False
If Len(sCellData) > iCharPos Then
If Mid(Sheet2.Cells(lRow, 1), iCharPos, 1) = Mid(sCellData, iCharPos, 1) Then
'chars are the same. Go to next icharpos
iCharPos = iCharPos + 1
Else
'check for numeric Second string
If IsNumeric(Mid(Sheet2.Cells(lRow, 1), iCharPos, 1)) Then
'if the data in thiscell is numeric, then it is less than any non-numeric chars
If IsNumeric(Mid(sCellData, iCharPos, 1)) Then
'both are numeric... straight compare
If Mid(sCellData, iCharPos, 1) > Mid(Sheet2.Cells(lRow, 1), iCharPos, 1) Then
'Switch and set bGreaterLessThan to true

aTempRow = Rows(lThisCell).Value
Rows(lThisCell).Value = Rows(lRow).Value
Rows(lRow).Value = aTempRow
bGreaterLessthan = True
Else
'do not switch and set bGreaterThan to true
bGreaterLessthan = True
End If
Else
'number needs to go last, so leave alone and set bGreaterLessThan to true
bGreaterLessthan = True
End If
Else 'Second String not numeric
If IsNumeric(Mid(sCellData, iCharPos, 1)) Then
'switch and set bgreaterlessthan to true
aTempRow = Rows(lThisCell).Value
Rows(lThisCell).Value = Rows(lRow).Value
Rows(lRow).Value = aTempRow
bGreaterLessthan = True
Else
If Asc(Mid(Sheet2.Cells(lRow, 1), iCharPos, 1)) < Asc(Mid(sCellData, iCharPos, 1)) Then
'switch and set bGreaterLessThan to true
aTempRow = Rows(lThisCell).Value
Rows(lThisCell).Value = Rows(lRow).Value
Rows(lRow).Value = aTempRow
bGreaterLessthan = True
Else
bGreaterLessthan = True
End If
End If
End If
End If
Else
'either the two are identical, or they are the same but the second has more characters
'either case, switch the two and turn bgreaterthan true


aTempRow = Rows(lThisCell).Value
Rows(lThisCell).Value = Rows(lRow).Value
Rows(lRow).Value = aTempRow
bGreaterLessthan = True
End If
Wend
Next lRow
Next lThisCell


End Sub

mikerickson
12-03-2012, 01:45 PM
If I were going to bubble sort an array with this I'd do something like

Sub SortChrByChr(someArray as Variant)
' someArray is 1 dimensional, 1 based array
Dim i As long, j as Long

For i = 1 to UBound(someArray) - 1
For j = i +1 to UBound(someArray)
If LT(someArray(j), someArray(i)) Then
Temp = someArray(i)
someArray(i) = someArray(j)
someArray(j) = Temp
End If
Next j
Next i

Rem output the now sorted someArray
End Sub

Function LT(a as String, b as String) As Boolean
Dim i As long
For i = 1 to Len(a)
If IsNumeric(a) And IsNumberic(b) Then
If a <> b Then LT = (a < b): Exit Function
ElseIf IsNumeric(a) Then
LT = False
Exit Function
ElseIf IsNumeric(b) Then
LT = True
Exit Function
ElseIf a <> b Then
LT = (a < b): Exit Function
End If
Next i
End Function