KerryFSA

New Member
Joined
Dec 5, 2018
Messages
49
Following code hangs up on .Apply. Can you see why? Thanks very much.

‘ All variables have been defined and appear to have the correct values at this point.
' I have copy and pasted Range1, Range2, etc. to check their contents. And all looks good.


With ActiveWorkbook.Worksheets(sh)
Set Range1 = .Range(.Cells(r1, c1), .Cells(rL, cL)) ' Entire range to be sorted
Set Range2 = .Range(.Cells(r1, c2), .Cells(rL, c2)) ' supply code column
Set Range3 = .Range(.Cells(r1, c3), .Cells(rL, c3)) ' retailer name column
Set Range4 = .Range(.Cells(r1, c4), .Cells(rL, c4)) ' face value column
Set Range5 = .Range(.Cells(r1, cT), .Cells(rL, cT)) ' Type of retailer
End With

Select Case S ' set to 1
Case 1 ' Sort by Name, Value only
ActiveWorkbook.Worksheets(sh).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(sh).Sort.SortFields.Add2 Key:=Range3,
SortOn:=xlSortOnValues, order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(sh).Sort.SortFields.Add2 Key:=Range4,
SortOn:=xlSortOnValues, order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets(sh).Sort
.SetRange Range1
.Header = xlNo
.MatchCase = False
.Orientation = orient
.SortMethod = xlPinYin
.Apply
End With
 
Last edited:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Hello sunny Manitoba. I'm a Winnipeg boy myself.
The S and sh work properly above the sort routines.
I'll post more code if it doesn't work troday.
 
Upvote 0
Changes marked in red
Try this

Code:
    With ActiveWorkbook.Worksheets(sh)
        Set Range1 = .Range(.Cells(r1, c1), .Cells(rl, cL)) ' Entire range to be sorted
        Set Range2 = .Range(.Cells(r1, c2), .Cells(rl, c2)) ' supply code column
        Set Range3 = .Range(.Cells(r1, c3), .Cells(rl, c3)) ' retailer name column
        Set Range4 = .Range(.Cells(r1, c4), .Cells(rl, c4)) ' face value column
        Set Range5 = .Range(.Cells(r1, cT), .Cells(rl, cT)) ' Type of retailer
    End With
    
    Select Case S ' set to 1
        Case 1 ' Sort by Name, Value only
            ActiveWorkbook.Worksheets(sh).Sort.SortFields.Clear
            ActiveWorkbook.Worksheets(sh).Sort.SortFields.Add [COLOR=#ff0000]Key[/COLOR]:=Range3,[COLOR=#ff0000] _[/COLOR]
             SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            ActiveWorkbook.Worksheets(sh).Sort.SortFields.Add [COLOR=#ff0000]Key[/COLOR]:=Range4, [COLOR=#ff0000]_[/COLOR]
             SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets(sh).Sort
                .SetRange Range1
                .Header = xlNo
                .MatchCase = False
                .Orientation = orient
                .SortMethod = xlPinYin
                .Apply
            End With
    End Select

Or this:
Code:
    With ActiveWorkbook.Worksheets(sh)
        Set Range1 = .Range(.Cells(r1, c1), .Cells(rl, cL)) ' Entire range to be sorted
        Set Range2 = .Range(.Cells(r1, c2), .Cells(rl, c2)) ' supply code column
        Set Range3 = .Range(.Cells(r1, c3), .Cells(rl, c3)) ' retailer name column
        Set Range4 = .Range(.Cells(r1, c4), .Cells(rl, c4)) ' face value column
        Set Range5 = .Range(.Cells(r1, cT), .Cells(rl, cT)) ' Type of retailer
    End With
    
    Select Case S ' set to 1
        Case 1 ' Sort by Name, Value only
            With ActiveWorkbook.Worksheets(sh).Sort
                [COLOR=#ff0000].SortFields.Clear
                .SortFields.Add Key:=Range3, _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SortFields.Add Key:=Range4, _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal[/COLOR]
                .SetRange Range1
                .Header = xlNo
                .MatchCase = False
                .Orientation = orient
                .SortMethod = xlPinYin
                .Apply
            End With
    End Select

Or this

Code:
    With ActiveWorkbook.Worksheets(sh)
        Set range1 = .Range(.Cells(r1, c1), .Cells(rl, cL)) ' Entire range to be sorted
        Set Range2 = .Range(.Cells(r1, c2), .Cells(rl, c2)) ' supply code column
        Set Range3 = .Range(.Cells(r1, c3), .Cells(rl, c3)) ' retailer name column
        Set Range4 = .Range(.Cells(r1, c4), .Cells(rl, c4)) ' face value column
        Set Range5 = .Range(.Cells(r1, cT), .Cells(rl, cT)) ' Type of retailer
    End With
    
    Select Case S ' set to 1
        Case 1 ' Sort by Name, Value only
            [COLOR=#ff0000]range1.Sort key1:=Range3, order1:=xlAscending, key2:=Range4, order2:=xlAscending, Header:=xlNo
 [/COLOR]   End Select
 
Last edited:
Upvote 0
Of the 3 suggestions in post 8, only the last one runs without stopping. However, the columns of the resulting Sort are completely scrambled.
Here's a more complete version of my code:


Sub SortRetailersX()

Dim Range1, Range2, Range3, Range4 As Range
Dim SArray As Variant, CPArray As Variant, sh As String
Dim r1, rL, c1, c2, c3, c4, cL, L, orient As Long


sh = "RETAILERS"
SArray = Worksheets(sh).ListObjects("Stable").DataBodyRange
CPArray = Worksheets(sh).ListObjects("CPtable").DataBodyRange
orient = 2
L = 1
' VALUES BELOW WERE TESTED BY MsgBox
sh = SArray(1, L) ' = RETAILERS name of sheet to be sorted
r1 = SArray(2, L) ' = 10 first row in whole matrix
rL = SArray(4, L) ' = 78 last row in active matrix
c1 = SArray(5, L) ' = 4 first col in whole matrix
cL = SArray(6, L) ' = 15 last col in whole matrix
c2 = SArray(7, L) ' = 7 col of Supply Code
c3 = SArray(8, L) ' = 9 col for retailer names
c4 = SArray(9, L) ' = 10 sales price

With ActiveWorkbook.Worksheets(sh)
Set Range1 = .Range(.Cells(r1, c1), .Cells(rL, cL)) ' Entire range
Set Range2 = .Range(.Cells(r1, c2), .Cells(rL, c2)) ' sort column 1
Set Range3 = .Range(.Cells(r1, c3), .Cells(rL, c3)) ' sort column 2
Set Range4 = .Range(.Cells(r1, c4), .Cells(rL, c4)) ' sort column 3
End With


ActiveWorkbook.Worksheets(sh).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(sh).Sort.SortFields.Add Key:=Range3, SortOn:=xlSortOnValues, order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(sh).Sort.SortFields.Add Key:=Range4, SortOn:=xlSortOnValues, order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets(sh).Sort
.SetRange Range1
.Header = xlNo
.MatchCase = False
.Orientation = orient
.SortMethod = xlPinYin
.Apply
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,949
Members
448,534
Latest member
benefuexx

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