Although this is similar to previous posts, it is different enough that
earlier solutions did not resolve my problem.

I am sorting a list of part numbers. They are in a three-part format --
prefix, base, suffix. The base is always numeric. The prefix and suffix are
alphabetic. A number may be comprised of one, two, or all three of the
sections. I want the numbers sorted by base first, then by prefix and then
by suffix. See a portion of my list below:

100MS
1577
200322
200861
200886S
202CCAG
40MPB
40MS
40MST
8984YY
90MS
AEL0801H
CDS211TTRW
DC216TTRB
DS206GG
P90R
PAWT214RA
PNR112R
WPS207GRC
WPSH115RRC

I want the 40xx numbers to come before 100MS and before 1157. Can this be
done in Excel 2003?

Thanks for any help you can give me.

Here are 2 UDF that might help with the sort:
Extract numbers will capture the number in a string and ExtractAlpha
extracts the alpha value in a string.

Insert 2 blank columns in a copy of the your workbook, to the right of the
column that contains your list. In first blank column type
=ExtractNumbers(A1) and copy down to the last value in your list, in second
blank column type =ExtractAlpha(A1) and copy down to the last value in your
list. Then do a 2-way sort using the first formula column as sort parameter
1 and the second formula column as sort parameter 2.

To use the formulas, press Alt+F11 to open the VBE. Click INSERT on the
menu and select Module, then paste or type the 2 formulas below.

Function ExtractNumbers(varVal As Variant) As Long


Dim intLen As Integer
Dim strVal As String
Dim i As Integer
Dim strChar As String

intLen = Len(varVal)

For i = 1 To intLen
strChar = Mid$(varVal, i, 1)
If IsNumeric(strChar) Then strVal = strVal & strChar
Next i

If Len(strVal) = 0 Then
ExtractNumbers = 0
Else
ExtractNumbers = CLng(strVal)
End If

End Function

Function ExtractAlpha(varVal As Variant) As String

Dim intLen As Integer
Dim strVal As String
Dim i As Integer
Dim strChar As String

intLen = Len(varVal)

For i = 1 To intLen
strChar = Mid$(varVal, i, 1)
If Asc(strChar) = 65 And Asc(strChar) <= 90 Or _
Asc(strChar) = 97 And Asc(strChar) <= 122 Then
strVal = strVal & strChar
End If
Next i

ExtractAlpha = strVal

End Function


--
Kevin Backmann


"JDrumm" wrote:

Although this is similar to previous posts, it is different enough that
earlier solutions did not resolve my problem.

I am sorting a list of part numbers. They are in a three-part format --
prefix, base, suffix. The base is always numeric. The prefix and suffix are
alphabetic. A number may be comprised of one, two, or all three of the
sections. I want the numbers sorted by base first, then by prefix and then
by suffix. See a portion of my list below:

100MS
1577
200322
200861
200886S
202CCAG
40MPB
40MS
40MST
8984YY
90MS
AEL0801H
CDS211TTRW
DC216TTRB
DS206GG
P90R
PAWT214RA
PNR112R
WPS207GRC
WPSH115RRC

I want the 40xx numbers to come before 100MS and before 1157. Can this be
done in Excel 2003?

Thanks for any help you can give me.

On Fri, 7 Sep 2007 12:18:02 -0700, JDrumm
wrote:

Although this is similar to previous posts, it is different enough that
earlier solutions did not resolve my problem.

I am sorting a list of part numbers. They are in a three-part format --
prefix, base, suffix. The base is always numeric. The prefix and suffix are
alphabetic. A number may be comprised of one, two, or all three of the
sections. I want the numbers sorted by base first, then by prefix and then
by suffix. See a portion of my list below:

100MS
1577
200322
200861
200886S
202CCAG
40MPB
40MS
40MST
8984YY
90MS
AEL0801H
CDS211TTRW
DC216TTRB
DS206GG
P90R
PAWT214RA
PNR112R
WPS207GRC
WPSH115RRC

I want the 40xx numbers to come before 100MS and before 1157. Can this be
done in Excel 2003?

Thanks for any help you can give me.

The following should get you started.

It does not check for a valid part number configuration, but the routine will
crash if that happens, so you can work out how you want to handle it.

As written, it sorts a single column of values and writes those values, sorted
into a column starting with rDest (G1 in this example).

Note that the list is determined by expanding the Selected cell to the current
region, and then assuming that the first row is a label.

The part numbers are parsed into an array where the elements correspond to
prefix, base and suffix. The sort routine can sort on each element.

IT sorts your list:

40MPB
40MS
40MST
90MS
P90R
100MS
PNR112R
WPSH115RRC
202CCAG
DS206GG
WPS207GRC
CDS211TTRW
PAWT214RA
DC216TTRB
AEL801H
1577
8984YY
200322
200861
200886S

================================================== ===
Option Explicit
Sub SortPNs()
Dim tPN As Variant
Dim PN()
Dim i As Long, j As Long
Dim rDest As Range
Set rDest = Range("G1")

Dim c As Range, rg As Range
'Expand to current region

Set rg = Selection.CurrentRegion
'Assume header row

Set rg = rg.Offset(1, 0).Resize(rg.Count - 1, 1)
ReDim PN(0 To rg.Count - 1, 0 To 2)
i = 0
For Each c In rg
tPN = ParsePN(c.Value)
PN(i, 0) = tPN(0) 'prefix
PN(i, 1) = Val(tPN(1)) 'number base; _
force to number for sort routine
PN(i, 2) = tPN(2) 'suffix
i = i + 1
Next c

'Sort from least to most significant
PN = BubbleSort(PN, 2) 'suffix
PN = BubbleSort(PN, 0) 'prefix
PN = BubbleSort(PN, 1) 'number base

rDest.EntireColumn.ClearContents
For i = 0 To UBound(PN)
rDest.Offset(i, 0).Value = _
PN(i, 0) & PN(i, 1) & PN(i, 2)
Next i
End Sub
'-------------------------------------------------------
Private Function ParsePN(str As String) As Variant
Dim re As RegExp
Dim mc As MatchCollection
Dim t(2)
Dim i As Long

Set re = New RegExp
With re
.Global = True
.Pattern = "^(\D*)(\d+)(\D*)$"
If .Test(str) = True Then
Set mc = .Execute(str)
For i = 0 To 2
t(i) = mc(0).SubMatches(i)
Next i
ParsePN = t
Else
ParsePN = "" 'will cause error in main section
End If
End With
End Function
'-----------------------------------------------------------
Private Function BubbleSort(TempArray As Variant, d As Long) _
'D is dimension to sort on
Dim temp() As Variant
Dim i As Integer, j As Integer, k As Integer
Dim NoExchanges As Boolean

k = UBound(TempArray, 2)
ReDim temp(0, k)

Do
NoExchanges = True

For i = 0 To UBound(TempArray) - 1
If TempArray(i, d) TempArray(i + 1, d) Then
NoExchanges = False
For j = 0 To k
temp(0, j) = TempArray(i, j)
TempArray(i, j) = TempArray(i + 1, j)
TempArray(i + 1, j) = temp(0, j)
Next j
End If
Next i
Loop While Not NoExchanges

BubbleSort = TempArray
End Function
========================================
--ron

Hello,

If your data is in column A starting from row 2 then enter into
B2:
=regexpreplace($A2,"^(\D*)(\d+)(.*)$","$1")
C2:
=--regexpreplace($A2,"^(\D*)(\d+)(.*)$","$2")
D2:
=regexpreplace($A2,"^(\D*)(\d+)(.*)$","$3")
copy down as far as necessary and sort by columns C, B and D

Regards,
Bernd

PS: [not my invention:]
Function RegExpReplace(ByVal SourceString As String, _
ByVal Pattern As String, ByVal ReplaceString As String, _
Optional ByVal IgnoreCase As Boolean = False, _
Optional ByVal GlobalReplace As Boolean = False, _
Optional ByVal MultiLine As Boolean = False) As String

Dim objRE As Object

Set objRE = CreateObject("vbscript.regexp")
objRE.Pattern = Pattern
objRE.IgnoreCase = IgnoreCase
objRE.Global = GlobalReplace
objRE.MultiLine = MultiLine

RegExpReplace = objRE.Replace(SourceString, ReplaceString)
Set objRE = Nothing
End Function