PDA

View Full Version : [SOLVED] Help with a difficult sort



Obfuscated
10-07-2016, 05:06 AM
I need to correctly sort 6 columns of data. Example data:


W18X76 A9 55 2 X EA
W18X100 A9 55 2 X EA
W18X320 A8 45 1 A EX

I need to sort by the first column, second column, third column (hierarchy). The remaining columns just need to follow the route.
My trouble is that when the first column is sorted, it will be:


W18X100
W18X320
W18X76

It needs to be sorted on the entire number, not the first digit. Correct return should be:


W18X76 ...
W18X100 ...
W18X320 ...


The first entry will always have a letter (or 2) to start that will be "W", or "HP", then a 2 or 3 digit number.
Sorting by the number after the "X" is the key sort needed.
I have no idea how to accomplish this.

mana
10-07-2016, 05:34 AM
1)insert column and enter this formula
2)sort
3)delete column above

=SUBSTITUTE(SUBSTITUTE(A1,"W",""),"HP","")*1

Obfuscated
10-07-2016, 05:59 AM
I had to edit the entry to include the "18X" after the "W". So this answer will not work. Sorry, I had abbreviated my initial examples.

Paul_Hossler
10-07-2016, 06:19 AM
This uses a temporary column to hold the prefix while the number portion is sorted.

It joins the prefix back to the number, and then deletes the temp column

Assumes there are headers and that the data starts in A1




Option Explicit
Sub Demo()
Dim rData As Range, rDataHeaders As Range, rNumber As Range
Dim iX As Long
Dim sTemp As String

Application.ScreenUpdating = False
ActiveSheet.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Value = "temp"
Set rDataHeaders = ActiveSheet.Cells(1, 1).CurrentRegion
With rDataHeaders
Set rData = .Cells(2, 1).Resize(.Rows.Count - 1, .Columns.Count)
End With

For Each rNumber In rData.Columns(1).Cells
With rNumber
sTemp = .Value
iX = InStr(sTemp, "X")
.Value = Right(sTemp, Len(.Value) - iX)
.Offset(0, 1).Value = Left(sTemp, iX)
End With
Next


With Worksheets("Sheet1").Sort
.SortFields.Clear
.SortFields.Add Key:=rData.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rData.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rData.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rDataHeaders
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

For Each rNumber In rData.Columns(1).Cells
With rNumber
.Value = .Offset(0, 1).Value & .Value
End With
Next
Columns("B:B").Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

mana
10-07-2016, 06:22 AM
=MID(A1,FIND("X",A1)+1,3)

Obfuscated
10-07-2016, 07:10 AM
I have posted the WB so you can see the code already written.
Thanks guys for the help.

Paul_Hossler
10-07-2016, 10:57 AM
I inserted the macro from post #4 and made some changes

Two lines are marked testing since I just wanted to see the sort part




JumpHere: '<<<<<<<<<<<<<<<<<<<<<<<<<< testing

Dim rData As Range, rDataHeaders As Range, rNumber As Range
Dim iX As Long
Dim sTemp As String

Application.ScreenUpdating = False
ws.Range("B3", Range("B3").End(xlDown)).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B3").Value = "temp"
Set rDataHeaders = ActiveSheet.Cells(1, 1).CurrentRegion
With rDataHeaders
Set rDataHeaders = .Cells(3, 1).Resize(.Rows.Count - 2, .Columns.Count)
End With

With rDataHeaders
Set rData = .Cells(2, 1).Resize(.Rows.Count - 1, .Columns.Count)
End With


For Each rNumber In rData.Columns(1).Cells
With rNumber
sTemp = .Value
iX = InStr(sTemp, "X")
.Value = Right(sTemp, Len(.Value) - iX)
.Offset(0, 1).Value = Left(sTemp, iX)
End With
Next


With ws.Sort
.SortFields.Clear
.SortFields.Add Key:=rData.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rData.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rData.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rDataHeaders
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

For Each rNumber In rData.Columns(1).Cells
With rNumber
.Value = .Offset(0, 1).Value & .Value
End With
Next

ws.Range("B3", Range("B3").End(xlDown)).Delete Shift:=xlToLeft
Application.ScreenUpdating = True
'----------------------------------------------------------------------------------------------------

Obfuscated
10-10-2016, 02:23 AM
That worked GREAT. Thank you very much.