Help to sort road addresses - Complex Sort Scenario

M

mazher

Active Member
Joined
Nov 26, 2003
Messages
363
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi All Excel Gurus,

I have address in one column as follows

1 ABC Road
1a ABC Road
10 ABC Road
11 ABC Road
11a ABC Road
2 ABC Road
3 ABC Road
6 ABC Road
7 ABC Road
52 XYZ Road
The Mansion , 8 BCD Road
The Quadrant , 8a BCD Road
Flat 3, 35 BCD Road
51 BCD Road
21 ABC Road
Flat 1 23 ABC Road
5 Court PQR Road
2 Court PQR Road
7 Court PQR Road
2a Court PQR Road


I need them sorted in the road order as follows
1 ABC Road
1a ABC Road
2 ABC Road
3 ABC Road
6 ABC Road
7 ABC Road
10 ABC Road
11 ABC Road
11a ABC Road
21 ABC Road
Flat 1 23 ABC Road
The Mansion , 8 BCD Road
The Quadrant , 8a BCD Road
Flat 3 35 BCD Road
51 BCD Road
2 Court PQR Road
2a Court PQR Road
5 Court PQR Road
7 Court PQR Road
52 XYZ Road


Please can some one help me either with the formula approach or with VBA.

I will be extremely thankful for that, as its driving me crazy.
 
Sort by date Sort by votes
Akuini said:
Hm, it's more complex than I thought.
I don't understand the criteria for the sort.
Why is Totteridge Road above Hicks Farm Rise?
Thomas Cottage, 271A Totteridge Road
7 Conway House, Hicks Farm Rise
Click to expand...

Sorry its my fault as I am doing it manually forgot to arrange it , here is the correct order again

Flat 1, 145 Bowerdean Road
7 Conway House, Hicks Farm Rise
Flat B, 21 Totteridge Lane
Heartoak House, 21a Totteridge Lane
3 Denewood, Totteridge Road
8 Denewood, Totteridge Road
10 Denewood, Totteridge Road
Thomas Cottage, 271A Totteridge Road
1 Ely House, Leas Close
1 Hereford House, Leas Close
2 York House, Leas Close
20 Leas Close
21 Leas Close
25 Chartridge House, Windrush Drive
1 Windrush Court, Windrush Drive
 
Upvote 0

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Ok, try this:
I didn't delete the helper column, incase you need it.

Code: 
[FONT=lucida console][color=Royalblue]Sub[/color] a1086751b()
[i][color=seagreen]'https://www.mrexcel.com/forum/excel-questions/1086751-help-sort-road-addresses-complex-sort-scenario.html[/color][/i]
[color=Royalblue]Dim[/color] i [color=Royalblue]As[/color] [color=Royalblue]Long[/color], j [color=Royalblue]As[/color] [color=Royalblue]Long[/color], n [color=Royalblue]As[/color] [color=Royalblue]Long[/color]
[color=Royalblue]Dim[/color] va, vb, x, q, y, p, z

Application.ScreenUpdating = [color=Royalblue]False[/color]
n = Range([color=brown]"A"[/color] & Rows.count).[color=Royalblue]End[/color](xlUp).Row
va = Range([color=brown]"A1:A"[/color] & n)
[color=Royalblue]ReDim[/color] vb([color=crimson]1[/color] [color=Royalblue]To[/color] UBound(va, [color=crimson]1[/color]), [color=crimson]1[/color] [color=Royalblue]To[/color] [color=crimson]2[/color])


[color=Royalblue]For[/color] i = [color=crimson]1[/color] [color=Royalblue]To[/color] UBound(va, [color=crimson]1[/color])
    z = va(i, [color=crimson]1[/color])
    x = Split(z, [color=brown]" "[/color])
    
    [color=Royalblue]If[/color] IsNumeric(Left(z, [color=crimson]1[/color])) [color=Royalblue]Then[/color]
            
        [color=Royalblue]For[/color] j = LBound(x) + [color=crimson]1[/color] [color=Royalblue]To[/color] UBound(x)
        vb(i, [color=crimson]1[/color]) = vb(i, [color=crimson]1[/color]) & [color=brown]" "[/color] & x(j)
        [color=Royalblue]Next[/color]
        
        vb(i, [color=crimson]2[/color]) = x([color=crimson]0[/color])
            
    [color=Royalblue]Else[/color]
        
        [color=Royalblue]If[/color] InStr(z, [color=brown]","[/color]) [color=Royalblue]Then[/color]
            y = Split(z, [color=brown]","[/color])
            p = Split(y([color=crimson]1[/color]), [color=brown]" "[/color])
            vb(i, [color=crimson]2[/color]) = p([color=crimson]1[/color])
            
            [color=Royalblue]For[/color] j = LBound(p) + [color=crimson]2[/color] [color=Royalblue]To[/color] UBound(p)
                vb(i, [color=crimson]1[/color]) = vb(i, [color=crimson]1[/color]) & [color=brown]" "[/color] & p(j)
            [color=Royalblue]Next[/color]
        [color=Royalblue]End[/color] [color=Royalblue]If[/color]
    
    [color=Royalblue]End[/color] [color=Royalblue]If[/color]

[color=Royalblue]Next[/color]

    [color=Royalblue]For[/color] i = [color=crimson]1[/color] [color=Royalblue]To[/color] UBound(vb, [color=crimson]1[/color])
        z = vb(i, [color=crimson]1[/color])
        
        [color=Royalblue]If[/color] InStr(z, [color=brown]","[/color]) [color=Royalblue]Then[/color]
        vb(i, [color=crimson]1[/color]) = Split(z, [color=brown]","[/color])([color=crimson]1[/color])
        [color=Royalblue]End[/color] [color=Royalblue]If[/color]
            
            vb(i, [color=crimson]1[/color]) = Trim(vb(i, [color=crimson]1[/color]))
            z = vb(i, [color=crimson]2[/color])
        
        [color=Royalblue]If[/color] [color=Royalblue]Not[/color] IsNumeric(z) [color=Royalblue]Then[/color]
            vb(i, [color=crimson]2[/color]) = Left(z, Len(z) - [color=crimson]1[/color])
            [color=Royalblue]If[/color] IsNumeric(vb(i, [color=crimson]2[/color])) [color=Royalblue]Then[/color] vb(i, [color=crimson]2[/color]) = vb(i, [color=crimson]2[/color]) + [color=crimson]0.1[/color]
        [color=Royalblue]End[/color] [color=Royalblue]If[/color]
    [color=Royalblue]Next[/color]


Range([color=brown]"D1"[/color]).Resize(UBound(vb, [color=crimson]1[/color]), [color=crimson]2[/color]) = vb
Range([color=brown]"A1:E"[/color] & n).Sort Key1:=Range([color=brown]"C1"[/color]), order1:=xlAscending, Key2:=Range([color=brown]"D1"[/color]), order2:=xlAscending, Header:=xlNo
[i][color=seagreen]'Range("D1:E" & n).ClearContents[/color][/i]
Application.ScreenUpdating = [color=Royalblue]True[/color]

[color=Royalblue]End[/color] [color=Royalblue]Sub[/color][/FONT]


RESULT:

Excel 2013 32 bit
[Table="width:, class:head"][tr=bgcolor:#008B8B][th] [/th][th]
A​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
1​
[/td][td]Flat 1, 145 Bowerdean Road[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
2​
[/td][td]7 Conway House, Hicks Farm Rise[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
3​
[/td][td]20 Leas Close, High Wycombe[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
4​
[/td][td]21 Leas Close, High Wycombe[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
5​
[/td][td]1 Ely House, Leas Close[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
6​
[/td][td]1 Hereford House, Leas Close[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
7​
[/td][td]2 York House, Leas Close[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
8​
[/td][td]Flat B, 21 Totteridge Lane[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
9​
[/td][td]Heartoak House, 21a Totteridge Lane[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
10​
[/td][td]Thomas Cottage, 271A Totteridge Road[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
11​
[/td][td]3 Denewood, Totteridge Road[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
12​
[/td][td]8 Denewood, Totteridge Road[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
13​
[/td][td]10 Denewood, Totteridge Road[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
14​
[/td][td]1 Windrush Court, Windrush Drive[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
15​
[/td][td]25 Chartridge House, Windrush Drive[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet5[/td][/tr][/table]
 
Upvote 0
Akuini said:
Ok, try this:
I didn't delete the helper column, incase you need it.

Code: 
[FONT=lucida console][color=Royalblue]Sub[/color] a1086751b()
[i][color=seagreen]'https://www.mrexcel.com/forum/excel-questions/1086751-help-sort-road-addresses-complex-sort-scenario.html[/color][/i]
[color=Royalblue]Dim[/color] i [color=Royalblue]As[/color] [color=Royalblue]Long[/color], j [color=Royalblue]As[/color] [color=Royalblue]Long[/color], n [color=Royalblue]As[/color] [color=Royalblue]Long[/color]
[color=Royalblue]Dim[/color] va, vb, x, q, y, p, z

Application.ScreenUpdating = [color=Royalblue]False[/color]
n = Range([color=brown]"A"[/color] & Rows.count).[color=Royalblue]End[/color](xlUp).Row
va = Range([color=brown]"A1:A"[/color] & n)
[color=Royalblue]ReDim[/color] vb([color=crimson]1[/color] [color=Royalblue]To[/color] UBound(va, [color=crimson]1[/color]), [color=crimson]1[/color] [color=Royalblue]To[/color] [color=crimson]2[/color])


[color=Royalblue]For[/color] i = [color=crimson]1[/color] [color=Royalblue]To[/color] UBound(va, [color=crimson]1[/color])
    z = va(i, [color=crimson]1[/color])
    x = Split(z, [color=brown]" "[/color])
    
    [color=Royalblue]If[/color] IsNumeric(Left(z, [color=crimson]1[/color])) [color=Royalblue]Then[/color]
            
        [color=Royalblue]For[/color] j = LBound(x) + [color=crimson]1[/color] [color=Royalblue]To[/color] UBound(x)
        vb(i, [color=crimson]1[/color]) = vb(i, [color=crimson]1[/color]) & [color=brown]" "[/color] & x(j)
        [color=Royalblue]Next[/color]
        
        vb(i, [color=crimson]2[/color]) = x([color=crimson]0[/color])
            
    [color=Royalblue]Else[/color]
        
        [color=Royalblue]If[/color] InStr(z, [color=brown]","[/color]) [color=Royalblue]Then[/color]
            y = Split(z, [color=brown]","[/color])
            p = Split(y([color=crimson]1[/color]), [color=brown]" "[/color])
            vb(i, [color=crimson]2[/color]) = p([color=crimson]1[/color])
            
            [color=Royalblue]For[/color] j = LBound(p) + [color=crimson]2[/color] [color=Royalblue]To[/color] UBound(p)
                vb(i, [color=crimson]1[/color]) = vb(i, [color=crimson]1[/color]) & [color=brown]" "[/color] & p(j)
            [color=Royalblue]Next[/color]
        [color=Royalblue]End[/color] [color=Royalblue]If[/color]
    
    [color=Royalblue]End[/color] [color=Royalblue]If[/color]

[color=Royalblue]Next[/color]

    [color=Royalblue]For[/color] i = [color=crimson]1[/color] [color=Royalblue]To[/color] UBound(vb, [color=crimson]1[/color])
        z = vb(i, [color=crimson]1[/color])
        
        [color=Royalblue]If[/color] InStr(z, [color=brown]","[/color]) [color=Royalblue]Then[/color]
        vb(i, [color=crimson]1[/color]) = Split(z, [color=brown]","[/color])([color=crimson]1[/color])
        [color=Royalblue]End[/color] [color=Royalblue]If[/color]
            
            vb(i, [color=crimson]1[/color]) = Trim(vb(i, [color=crimson]1[/color]))
            z = vb(i, [color=crimson]2[/color])
        
        [color=Royalblue]If[/color] [color=Royalblue]Not[/color] IsNumeric(z) [color=Royalblue]Then[/color]
            vb(i, [color=crimson]2[/color]) = Left(z, Len(z) - [color=crimson]1[/color])
            [color=Royalblue]If[/color] IsNumeric(vb(i, [color=crimson]2[/color])) [color=Royalblue]Then[/color] vb(i, [color=crimson]2[/color]) = vb(i, [color=crimson]2[/color]) + [color=crimson]0.1[/color]
        [color=Royalblue]End[/color] [color=Royalblue]If[/color]
    [color=Royalblue]Next[/color]


Range([color=brown]"D1"[/color]).Resize(UBound(vb, [color=crimson]1[/color]), [color=crimson]2[/color]) = vb
Range([color=brown]"A1:E"[/color] & n).Sort Key1:=Range([color=brown]"C1"[/color]), order1:=xlAscending, Key2:=Range([color=brown]"D1"[/color]), order2:=xlAscending, Header:=xlNo
[i][color=seagreen]'Range("D1:E" & n).ClearContents[/color][/i]
Application.ScreenUpdating = [color=Royalblue]True[/color]

[color=Royalblue]End[/color] [color=Royalblue]Sub[/color][/FONT]


RESULT:

Excel 2013 32 bit
[Table="width:, class:head"][tr=bgcolor:#008B8B][th] [/th][th]
A​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
1​
[/td][td]Flat 1, 145 Bowerdean Road[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
2​
[/td][td]7 Conway House, Hicks Farm Rise[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
3​
[/td][td]20 Leas Close, High Wycombe[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
4​
[/td][td]21 Leas Close, High Wycombe[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
5​
[/td][td]1 Ely House, Leas Close[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
6​
[/td][td]1 Hereford House, Leas Close[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
7​
[/td][td]2 York House, Leas Close[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
8​
[/td][td]Flat B, 21 Totteridge Lane[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
9​
[/td][td]Heartoak House, 21a Totteridge Lane[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
10​
[/td][td]Thomas Cottage, 271A Totteridge Road[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
11​
[/td][td]3 Denewood, Totteridge Road[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
12​
[/td][td]8 Denewood, Totteridge Road[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
13​
[/td][td]10 Denewood, Totteridge Road[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
14​
[/td][td]1 Windrush Court, Windrush Drive[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
15​
[/td][td]25 Chartridge House, Windrush Drive[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet5[/td][/tr][/table]
Click to expand...

Extremely thankful for all your help and time.

Just for my curiosity please can you tell me what are the numbers in the helper column
 
Upvote 0
You're welcome, glad to help, & thanks for the feedback.:)
The numbers are the number of each address, we need it as second criteria for the sorting.
 
Upvote 0
Sorry, the above code actually is flawed, I need to revised the columns for the sort criteria. So use this one instead:

Code: 
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1086751b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1086751-help-sort-road-addresses-complex-sort-scenario.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, vb, x, q, y, p, z

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
n = Range([COLOR=brown]"A"[/COLOR] & Rows.count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
va = Range([COLOR=brown]"A1:A"[/COLOR] & n)
[COLOR=Royalblue]ReDim[/COLOR] vb([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR])


[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    z = va(i, [COLOR=crimson]1[/COLOR])
    x = Split(z, [COLOR=brown]" "[/COLOR])
    
    [COLOR=Royalblue]If[/COLOR] IsNumeric(Left(z, [COLOR=crimson]1[/COLOR])) [COLOR=Royalblue]Then[/COLOR]
            
        [COLOR=Royalblue]For[/COLOR] j = LBound(x) + [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(x)
        vb(i, [COLOR=crimson]1[/COLOR]) = vb(i, [COLOR=crimson]1[/COLOR]) & [COLOR=brown]" "[/COLOR] & x(j)
        [COLOR=Royalblue]Next[/COLOR]
        
        vb(i, [COLOR=crimson]2[/COLOR]) = x([COLOR=crimson]0[/COLOR])
            
    [COLOR=Royalblue]Else[/COLOR]
        
        [COLOR=Royalblue]If[/COLOR] InStr(z, [COLOR=brown]","[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
            y = Split(z, [COLOR=brown]","[/COLOR])
            p = Split(y([COLOR=crimson]1[/COLOR]), [COLOR=brown]" "[/COLOR])
            vb(i, [COLOR=crimson]2[/COLOR]) = p([COLOR=crimson]1[/COLOR])
            
            [COLOR=Royalblue]For[/COLOR] j = LBound(p) + [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(p)
                vb(i, [COLOR=crimson]1[/COLOR]) = vb(i, [COLOR=crimson]1[/COLOR]) & [COLOR=brown]" "[/COLOR] & p(j)
            [COLOR=Royalblue]Next[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

[COLOR=Royalblue]Next[/COLOR]

    [COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(vb, [COLOR=crimson]1[/COLOR])
        z = vb(i, [COLOR=crimson]1[/COLOR])
        
        [COLOR=Royalblue]If[/COLOR] InStr(z, [COLOR=brown]","[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
        vb(i, [COLOR=crimson]1[/COLOR]) = Split(z, [COLOR=brown]","[/COLOR])([COLOR=crimson]1[/COLOR])
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
            
            vb(i, [COLOR=crimson]1[/COLOR]) = Trim(vb(i, [COLOR=crimson]1[/COLOR]))
            z = vb(i, [COLOR=crimson]2[/COLOR])
        
        [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] IsNumeric(z) [COLOR=Royalblue]Then[/COLOR]
            vb(i, [COLOR=crimson]2[/COLOR]) = Left(z, Len(z) - [COLOR=crimson]1[/COLOR])
            [COLOR=Royalblue]If[/COLOR] IsNumeric(vb(i, [COLOR=crimson]2[/COLOR])) [COLOR=Royalblue]Then[/COLOR] vb(i, [COLOR=crimson]2[/COLOR]) = vb(i, [COLOR=crimson]2[/COLOR]) + [COLOR=crimson]0.1[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]


Range([COLOR=brown]"D1"[/COLOR]).Resize(UBound(vb, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]2[/COLOR]) = vb
Range([COLOR=brown]"A1:E"[/COLOR] & n).Sort Key1:=Range([COLOR=brown]"D1"[/COLOR]), order1:=xlAscending, Key2:=Range([COLOR=brown]"E1"[/COLOR]), order2:=xlAscending, Header:=xlNo
[I][COLOR=seagreen]'Range("D1:E" & n).ClearContents[/COLOR][/I]
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 
Upvote 0
Akuini said:
Sorry, the above code actually is flawed, I need to revised the columns for the sort criteria. So use this one instead:

Code: 
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1086751b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1086751-help-sort-road-addresses-complex-sort-scenario.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, vb, x, q, y, p, z

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
n = Range([COLOR=brown]"A"[/COLOR] & Rows.count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
va = Range([COLOR=brown]"A1:A"[/COLOR] & n)
[COLOR=Royalblue]ReDim[/COLOR] vb([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR])


[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    z = va(i, [COLOR=crimson]1[/COLOR])
    x = Split(z, [COLOR=brown]" "[/COLOR])
    
    [COLOR=Royalblue]If[/COLOR] IsNumeric(Left(z, [COLOR=crimson]1[/COLOR])) [COLOR=Royalblue]Then[/COLOR]
            
        [COLOR=Royalblue]For[/COLOR] j = LBound(x) + [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(x)
        vb(i, [COLOR=crimson]1[/COLOR]) = vb(i, [COLOR=crimson]1[/COLOR]) & [COLOR=brown]" "[/COLOR] & x(j)
        [COLOR=Royalblue]Next[/COLOR]
        
        vb(i, [COLOR=crimson]2[/COLOR]) = x([COLOR=crimson]0[/COLOR])
            
    [COLOR=Royalblue]Else[/COLOR]
        
        [COLOR=Royalblue]If[/COLOR] InStr(z, [COLOR=brown]","[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
            y = Split(z, [COLOR=brown]","[/COLOR])
            p = Split(y([COLOR=crimson]1[/COLOR]), [COLOR=brown]" "[/COLOR])
            vb(i, [COLOR=crimson]2[/COLOR]) = p([COLOR=crimson]1[/COLOR])
            
            [COLOR=Royalblue]For[/COLOR] j = LBound(p) + [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(p)
                vb(i, [COLOR=crimson]1[/COLOR]) = vb(i, [COLOR=crimson]1[/COLOR]) & [COLOR=brown]" "[/COLOR] & p(j)
            [COLOR=Royalblue]Next[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

[COLOR=Royalblue]Next[/COLOR]

    [COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(vb, [COLOR=crimson]1[/COLOR])
        z = vb(i, [COLOR=crimson]1[/COLOR])
        
        [COLOR=Royalblue]If[/COLOR] InStr(z, [COLOR=brown]","[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
        vb(i, [COLOR=crimson]1[/COLOR]) = Split(z, [COLOR=brown]","[/COLOR])([COLOR=crimson]1[/COLOR])
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
            
            vb(i, [COLOR=crimson]1[/COLOR]) = Trim(vb(i, [COLOR=crimson]1[/COLOR]))
            z = vb(i, [COLOR=crimson]2[/COLOR])
        
        [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] IsNumeric(z) [COLOR=Royalblue]Then[/COLOR]
            vb(i, [COLOR=crimson]2[/COLOR]) = Left(z, Len(z) - [COLOR=crimson]1[/COLOR])
            [COLOR=Royalblue]If[/COLOR] IsNumeric(vb(i, [COLOR=crimson]2[/COLOR])) [COLOR=Royalblue]Then[/COLOR] vb(i, [COLOR=crimson]2[/COLOR]) = vb(i, [COLOR=crimson]2[/COLOR]) + [COLOR=crimson]0.1[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]


Range([COLOR=brown]"D1"[/COLOR]).Resize(UBound(vb, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]2[/COLOR]) = vb
Range([COLOR=brown]"A1:E"[/COLOR] & n).Sort Key1:=Range([COLOR=brown]"D1"[/COLOR]), order1:=xlAscending, Key2:=Range([COLOR=brown]"E1"[/COLOR]), order2:=xlAscending, Header:=xlNo
[I][COLOR=seagreen]'Range("D1:E" & n).ClearContents[/COLOR][/I]
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
Click to expand...

Thanks again for an update.

I gave the data in my office so I will test it tomorrow, when I go to the office.

Please if possible if you can explain me what the code is doing , i will be extremely thankful to you once again.
 
Upvote 0
another way. In a code module add
Code: 
Function SortData(ByVal sAddress As String) As String


    Dim a As Variant, b As Variant


    a = Split(sAddress, ", ")(1 + CLng(Left$(sAddress, 1) Like "#"))
    b = Split(a)
    If Right$(b(0), 1) Like "#" Then b(0) = b(0) & " "
    SortData = b(1) & String(5 - Len(b(0)), "0") & b(0)


End Function
Then populate a field adjacent to the addresses with the formula. such as if data is in column A. B2 would have =SortData(A2)
Then sort the full data (columns A:B) on the column B entries.

HTH
 
Upvote 0
Akuini said:
Sorry, the above code actually is flawed, I need to revised the columns for the sort criteria. So use this one instead:

Code: 
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1086751b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1086751-help-sort-road-addresses-complex-sort-scenario.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, vb, x, q, y, p, z

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
n = Range([COLOR=brown]"A"[/COLOR] & Rows.count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
va = Range([COLOR=brown]"A1:A"[/COLOR] & n)
[COLOR=Royalblue]ReDim[/COLOR] vb([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR])


[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    z = va(i, [COLOR=crimson]1[/COLOR])
    x = Split(z, [COLOR=brown]" "[/COLOR])
    
    [COLOR=Royalblue]If[/COLOR] IsNumeric(Left(z, [COLOR=crimson]1[/COLOR])) [COLOR=Royalblue]Then[/COLOR]
            
        [COLOR=Royalblue]For[/COLOR] j = LBound(x) + [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(x)
        vb(i, [COLOR=crimson]1[/COLOR]) = vb(i, [COLOR=crimson]1[/COLOR]) & [COLOR=brown]" "[/COLOR] & x(j)
        [COLOR=Royalblue]Next[/COLOR]
        
        vb(i, [COLOR=crimson]2[/COLOR]) = x([COLOR=crimson]0[/COLOR])
            
    [COLOR=Royalblue]Else[/COLOR]
        
        [COLOR=Royalblue]If[/COLOR] InStr(z, [COLOR=brown]","[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
            y = Split(z, [COLOR=brown]","[/COLOR])
            p = Split(y([COLOR=crimson]1[/COLOR]), [COLOR=brown]" "[/COLOR])
            vb(i, [COLOR=crimson]2[/COLOR]) = p([COLOR=crimson]1[/COLOR])
            
            [COLOR=Royalblue]For[/COLOR] j = LBound(p) + [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(p)
                vb(i, [COLOR=crimson]1[/COLOR]) = vb(i, [COLOR=crimson]1[/COLOR]) & [COLOR=brown]" "[/COLOR] & p(j)
            [COLOR=Royalblue]Next[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

[COLOR=Royalblue]Next[/COLOR]

    [COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(vb, [COLOR=crimson]1[/COLOR])
        z = vb(i, [COLOR=crimson]1[/COLOR])
        
        [COLOR=Royalblue]If[/COLOR] InStr(z, [COLOR=brown]","[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
        vb(i, [COLOR=crimson]1[/COLOR]) = Split(z, [COLOR=brown]","[/COLOR])([COLOR=crimson]1[/COLOR])
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
            
            vb(i, [COLOR=crimson]1[/COLOR]) = Trim(vb(i, [COLOR=crimson]1[/COLOR]))
            z = vb(i, [COLOR=crimson]2[/COLOR])
        
        [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] IsNumeric(z) [COLOR=Royalblue]Then[/COLOR]
            vb(i, [COLOR=crimson]2[/COLOR]) = Left(z, Len(z) - [COLOR=crimson]1[/COLOR])
            [COLOR=Royalblue]If[/COLOR] IsNumeric(vb(i, [COLOR=crimson]2[/COLOR])) [COLOR=Royalblue]Then[/COLOR] vb(i, [COLOR=crimson]2[/COLOR]) = vb(i, [COLOR=crimson]2[/COLOR]) + [COLOR=crimson]0.1[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]


Range([COLOR=brown]"D1"[/COLOR]).Resize(UBound(vb, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]2[/COLOR]) = vb
Range([COLOR=brown]"A1:E"[/COLOR] & n).Sort Key1:=Range([COLOR=brown]"D1"[/COLOR]), order1:=xlAscending, Key2:=Range([COLOR=brown]"E1"[/COLOR]), order2:=xlAscending, Header:=xlNo
[I][COLOR=seagreen]'Range("D1:E" & n).ClearContents[/COLOR][/I]
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
Click to expand...

I tried the code on my data and its working fine except for

its sorting in the following order
1 Windrush Court, Windrush Drive
3 Windrush Drive
4 Windrush Drive
7 Windrush Court, Windrush Drive
13 Windrush Drive
13 Windrush Drive
14 Windrush Court, Windrush Drive
18 Windrush Drive
21 Windrush Drive
23 Windrush Drive
24 Windrush Drive
24 Windrush Drive
30 Windrush Drive
46 Windrush Drive
47 Windrush Court, Windrush Drive
48 Windrush Drive
48 Windrush Drive
57 Windrush Court, Windrush Drive
63 Windrush Drive
67 Windrush Drive
68 Windrush Drive
69 Windrush Court, Windrush Drive
70 Windrush Court, Windrush Drive
71 Windrush Court, Windrush Drive
81 Windrush Drive
117 Windrush Drive
125 Windrush Drive
125 Windrush Drive
135 Windrush Drive


and I need in the following order

3 Windrush Drive
4 Windrush Drive
13 Windrush Drive
13 Windrush Drive
18 Windrush Drive
21 Windrush Drive
23 Windrush Drive
24 Windrush Drive
24 Windrush Drive
30 Windrush Drive
46 Windrush Drive
48 Windrush Drive
48 Windrush Drive
63 Windrush Drive
67 Windrush Drive
68 Windrush Drive
81 Windrush Drive
117 Windrush Drive
125 Windrush Drive
125 Windrush Drive
135 Windrush Drive
1 Windrush Court, Windrush Drive
7 Windrush Court, Windrush Drive
14 Windrush Court, Windrush Drive
47 Windrush Court, Windrush Drive
57 Windrush Court, Windrush Drive
69 Windrush Court, Windrush Drive
70 Windrush Court, Windrush Drive
71 Windrush Court, Windrush Drive

Hope this data helps in understanding my problem.

Thanks again for your time.
 
Upvote 0
Fazza said:
another way. In a code module add
Code: 
Function SortData(ByVal sAddress As String) As String


    Dim a As Variant, b As Variant


    a = Split(sAddress, ", ")(1 + CLng(Left$(sAddress, 1) Like "#"))
    b = Split(a)
    If Right$(b(0), 1) Like "#" Then b(0) = b(0) & " "
    SortData = b(1) & String(5 - Len(b(0)), "0") & b(0)


End Function
Then populate a field adjacent to the addresses with the formula. such as if data is in column A. B2 would have =SortData(A2)
Then sort the full data (columns A:B) on the column B entries.

HTH
Click to expand...
Thanks Fazza

It works in the same way as with the code provided by Akuini,

But I am also facing the same problem as I am facing with Akuini code

I tried the code on my data and its working fine except for

its sorting in the following order
1 Windrush Court, Windrush Drive
3 Windrush Drive
4 Windrush Drive
7 Windrush Court, Windrush Drive
13 Windrush Drive
13 Windrush Drive
14 Windrush Court, Windrush Drive
18 Windrush Drive
21 Windrush Drive
23 Windrush Drive
24 Windrush Drive
24 Windrush Drive
30 Windrush Drive
46 Windrush Drive
47 Windrush Court, Windrush Drive
48 Windrush Drive
48 Windrush Drive
57 Windrush Court, Windrush Drive
63 Windrush Drive
67 Windrush Drive
68 Windrush Drive
69 Windrush Court, Windrush Drive
70 Windrush Court, Windrush Drive
71 Windrush Court, Windrush Drive
81 Windrush Drive
117 Windrush Drive
125 Windrush Drive
125 Windrush Drive
135 Windrush Drive


and I need in the following order

3 Windrush Drive
4 Windrush Drive
13 Windrush Drive
13 Windrush Drive
18 Windrush Drive
21 Windrush Drive
23 Windrush Drive
24 Windrush Drive
24 Windrush Drive
30 Windrush Drive
46 Windrush Drive
48 Windrush Drive
48 Windrush Drive
63 Windrush Drive
67 Windrush Drive
68 Windrush Drive
81 Windrush Drive
117 Windrush Drive
125 Windrush Drive
125 Windrush Drive
135 Windrush Drive
1 Windrush Court, Windrush Drive
7 Windrush Court, Windrush Drive
14 Windrush Court, Windrush Drive
47 Windrush Court, Windrush Drive
57 Windrush Court, Windrush Drive
69 Windrush Court, Windrush Drive
70 Windrush Court, Windrush Drive
71 Windrush Court, Windrush Drive
 
Upvote 0
hi, Mazher,

Glad to hear Akuini's code & mine worked correctly on initial sample data.

The new data is a type that wasn't represented originally - there is now a name with more than one type (road/drive/rise/close/court/etc).

If I understand correctly, the result you're wanting doesn't make sense to me as I thought alphabetic order was required. So court before drive. I've coded for that & assume your expected result is wrong. However if it isn't, please modify the code to suit your needs. Same for any future changes.

regards, Fazza
Code: 
Function SortOrder(ByVal sAddress As String) As String

    Dim a As Variant, b As Variant

    a = Split(sAddress, ", ")(1 + CLng(Left$(sAddress, 1) Like "#"))
    b = Split(a)
    If Right$(b(0), 1) Like "#" Then b(0) = b(0) & vbNullString
    On Error Resume Next
    SortOrder = b(2)
    SortOrder = b(1) & SortOrder & String(5 - Len(b(0)), "0") & b(0)

End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Sum Horizontal and Vertical
Replies
2
Views
185
ChetanPuri
C
T
  • Question Question
Make address field in separate columns
Replies
8
Views
786
6StringJazzer
6StringJazzer
C
  • Question Question
Automate Grouping of data in a report
Replies
0
Views
232
Cantrecallmyusername
C
N
  • Question Question
copying rows to other sheet if a condition is met- by using VBA code
Replies
2
Views
417
Noni
N
S
  • Question Question
Excel help
Replies
1
Views
420
samadhan 123
S

Forum statistics

Threads
1,223,275
Messages
6,171,122
Members
452,381
Latest member
Nova88

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