Need a macro to sort Rows with in location column

[Alphix]

Please help.
Excel is not sorting the data in the rows in location Column for some reason I do not understand why.
Need a macro to sort the Hyphened data. x-xx-xxx

Sort Macro.xlsx
	D	E
1	LOCATION	ITEM
2	9-6-0	bike
3	11-7-1	apple
4	3-11-3	car
5	11-7-3	balloon
6	11-7-4	bird
7	5-10-6	cat
8	9-6-29	dog
9	15-7-1	pear
10	19-4-1	wall
11	23-1-1	nails
12	27-3-1	hammer
13	37-3-9	screw
14	39-3-1	skates
15	41-7-6	ball
16	41-8-5	baseball
17	44-1-1	forks
18	44-3-9	plates
19	45-4-14	dish
20	47-2-17	bucket
21	47-3-1	mop
22	47-3-2	can
23	49-10-2	cup
24	54-1-3	paper
25	62-2-8	scissors
26	64-1-7	mask
27	9-5-13.5	heater
28	SC1-4-5	plant
Sheet1

 

[Zot]

Maybe you can show how sorting result you are expecting here since it seems like Excel is sorting referring to the left most number or whatever

 

[Alphix]

Hi Zot, the sort result should look like below. Basically the location represents as follows: Cabinet - Drawer - location.
It should sort the left most number (Cabinet) then sort the middle number (Drawer) then right most number (location).
I think excel thinks some of the locations are dates. I am not able to do a simple sort. Thank you for your help.

Sort Macro.xlsx
	M
1	LOCATION
2	3-11-3
3	5-10-6
4	9-5-13.5
5	9-6-0
6	9-6-29
7	11-7-1
8	11-7-3
9	11-7-4
10	15-7-1
11	19-4-1
12	23-1-1
13	27-3-1
14	37-3-9
15	39-3-1
16	41-7-6
17	41-8-5
18	44-1-1
19	44-3-9
20	45-4-14
21	47-2-17
22	47-3-1
23	47-3-2
24	49-10-2
25	54-1-3
26	62-2-8
27	64-1-7
28	SC1-4-5
Sheet2

 

[Zot]

I just make use of Excel sort. First split the number/variable into 3 using -(Dash) as delimiter and create table in a sheet named Sort. There will be 4 columns. Then I just sort using column A, B and C. Rewrite that back again to original sheet.

Sub SortDashNum()

Dim n&, eRow&
Dim Arry$()
Dim ws As Worksheet, wsSort As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")
ActiveWorkbook.Sheets.Add.Name = "Sort"
Set wsSort = ActiveWorkbook.Sheets("Sort")

Application.ScreenUpdating = False

eRow = ws.Range("A1").End(xlDown).Row
For n = 2 To eRow
    Arry = Split(Trim(ws.Range("A" & n)), "-")
    wsSort.Range("A" & n) = Arry(0)
    wsSort.Range("B" & n) = Arry(1)
    wsSort.Range("C" & n) = Arry(2)
    wsSort.Range("D" & n) = ws.Range("B" & n)
Next

wsSort.Range("A1") = "A"
wsSort.Range("B1") = "B"
wsSort.Range("C1") = "C"
wsSort.Range("D1") = "D"

wsSort.Range("A1", "D" & eRow).Select
With wsSort
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=Range("A2", "A" & eRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range("B2", "B" & eRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range("C2", "C" & eRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
With wsSort.Sort
    .SetRange Range("A1", "D" & eRow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

For n = 2 To eRow
    With ws
        .Range("A" & n) = wsSort.Range("A" & n) & "-" & wsSort.Range("B" & n) & "-" & wsSort.Range("C" & n)
        .Range("B" & n) = wsSort.Range("D" & n)
    End With
Next
Application.DisplayAlerts = False
wsSort.Delete
Application.DisplayAlerts = True

End Sub

 

[Alphix]

Hi Zot, this works really good.
can you please modify the macro to add additional columns?

I greatly appreciate it.

4_paste.xlsm
	D	E	F	G	H
1	LOCATION	ITEM	ITEM	ITEM	ITEM
2	9-6-0	bike	bike	bike	bike
3	11-7-1	apple	apple	apple	apple
4	3-11-3	car	car	car	car
5	11-7-3	balloon	balloon	balloon	balloon
6	11-7-4	bird	bird	bird	bird
7	5-10-6	cat	cat	cat	cat
8	9-6-29	dog	dog	dog	dog
9	15-7-1	pear	pear	pear	pear
10	19-4-1	wall	wall	wall	wall
11	23-1-1	nails	nails	nails	nails
12	27-3-1	hammer	hammer	hammer	hammer
13	37-3-9	screw	screw	screw	screw
14	39-3-1	skates	skates	skates	skates
15	41-7-6	ball	ball	ball	ball
16	41-8-5	baseball	baseball	baseball	baseball
17	44-1-1	forks	forks	forks	forks
18	44-3-9	plates	plates	plates	plates
19	45-4-14	dish	dish	dish	dish
20	47-2-17	bucket	bucket	bucket	bucket
21	47-3-1	mop	mop	mop	mop
22	47-3-2	can	can	can	can
23	49-10-2	cup	cup	cup	cup
24	54-1-3	paper	paper	paper	paper
25	62-2-8	scissors	scissors	scissors	scissors
26	64-1-7	mask	mask	mask	mask
27	9-5-13.5	heater	heater	heater	heater
28	SC1-4-5	plant	plant	plant	plant
Sheet3

 

[Zot]

When data in column A is split into column A, B and C, these are all the sorting column. The rest of column will just follow.

I have modified the code so that it become dynamic and able to accommodate any column number as long as Location column being mandatory in its position.

Sub SortDashNum()

Dim eCol$
Dim n&, m&, k&, eRow&, colCount&
Dim Arry$()
Dim ws As Worksheet, wsSort As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")
ActiveWorkbook.Sheets.Add.Name = "Sort"
Set wsSort = ActiveWorkbook.Sheets("Sort")

Application.ScreenUpdating = False

eRow = ws.Range("A1").End(xlDown).Row
colCount = ws.Range("A1").End(xlToRight).Column + 2

' Prepare the sorting column in wsSort
For n = 1 To colCount
    wsSort.Cells(1, n) = Chr(64 + n)
Next

' Write data to wsSort
For n = 2 To eRow
    Arry = Split(Trim(ws.Range("A" & n)), "-")
    k = -1
    For m = 1 To colCount
        If m < 4 Then
            k = k + 1
            wsSort.Cells(n, m) = Arry(k)
        Else
            wsSort.Cells(n, m) = ws.Cells(n, (m - 2))
        End If
    Next
Next

' Sort Data
wsSort.Range("A1", Chr(64 + colCount) & eRow).Select
With wsSort
    .Sort.SortFields.Clear
    For n = 1 To 3
        .Sort.SortFields.Add Key:=Range(Chr(64 + n) & "2", Chr(64 + n) & eRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Next
End With

With wsSort.Sort
    .SetRange Range("A1", Chr(64 + colCount) & eRow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

For n = 2 To eRow
    With ws
        .Range("A" & n) = wsSort.Range("A" & n) & "-" & wsSort.Range("B" & n) & "-" & wsSort.Range("C" & n)
        For m = 2 To colCount
            .Range(Chr(64 + m) & n) = wsSort.Range(Chr(66 + m) & n)
        Next
    End With
Next

Application.DisplayAlerts = False
wsSort.Delete
Application.DisplayAlerts = True

End Sub

 

[Alphix]

Zot, thank you very much. This fix the problem perfectly.
Everyone on this forum are awesome.
Thank you again.

Alphix

 

[Zot]

Zot, thank you very much. This fix the problem perfectly.
Everyone on this forum are awesome.
Thank you again.

Alphix

Thanks for updating