Sort By Column D THEN auto-scroll to currently selected Row's Column D value?

[jmpatrick]

I have code that sorts from A-Z based on Column D's values. After the Sort completes the cursor parks itself at B4. Works fine, but instead of parking at B4 I'd like to have the cursor scroll to the Value that was in Column D for the Row that was selected when the Sort macro was run.

Here's my current code...

Sub SortBySub()
Application.ScreenUpdating = False
    ActiveWindow.SmallScroll Down:=-189
    Rows("5:2000").Select
    ActiveWindow.ScrollRow = 1426
    ActiveWindow.ScrollRow = 4
    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Add Key:=Range( _
        "D5:D2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Add Key:=Range( _
        "C5:C2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Add Key:=Range( _
        "B5:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Calendar").Sort
        .SetRange Range("A5:BQ2000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B4").Select
    Application.ScreenUpdating = True
End Sub

Make sense?

 

[JackDanIce]

Try:

Sub SortBySub()

    Dim LR          As Long
    Dim rng         As Range
    Dim rngStart    As Range
    
    LR = Cells(Rows.count, 4).End(xlUp).row
    Set rng = ActiveWorkbook.Worksheets("Calendar").Range("A5:BQ" & LR)
    Set rngStart = ActiveCell
    
    Application.ScreenUpdating = False
    
    rng.Sort.SortFields.Clear
    rng.Sort.SortFields.add key:=Range("D5:D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
    rng.Sort.SortFields.add key:=Range("C5:C" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
    rng.Sort.SortFields.add key:=Range("B5:B" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
    With rng.Sort
        .SetRange Range("A5:BQ" & LR)
        .header = xlGuess
        .MatchCase = False
        .Orientation = XlTopBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        
    With Application
        .Goto rngStart, True
        .ScreenUpdating = True
    End With
    
    Set rng = Nothing
    Set rngStart = Nothing
    
End Sub

 

[jmpatrick]

Try:

Sub SortBySub()

    Dim LR          As Long
    Dim rng         As Range
    Dim rngStart    As Range
    
    LR = Cells(Rows.count, 4).End(xlUp).row
    Set rng = ActiveWorkbook.Worksheets("Calendar").Range("A5:BQ" & LR)
    Set rngStart = ActiveCell
    
    Application.ScreenUpdating = False
    
    rng.Sort.SortFields.Clear
    rng.Sort.SortFields.add key:=Range("D5:D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
    rng.Sort.SortFields.add key:=Range("C5:C" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
    rng.Sort.SortFields.add key:=Range("B5:B" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
    With rng.Sort
        .SetRange Range("A5:BQ" & LR)
        .header = xlGuess
        .MatchCase = False
        .Orientation = XlTopBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        
    With Application
        .Goto rngStart, True
        .ScreenUpdating = True
    End With
    
    Set rng = Nothing
    Set rngStart = Nothing
    
End Sub

Should

.Orientation = XlTopBottom

be

.Orientation = XlTopToBottom

?

 

[JackDanIce]

Yes, typo in my code

 

[jmpatrick]

Yes, typo in my code

I'm getting this error:

Run-time error '1004':

Unable to get the Sort property of the Range class

When I debug this is highlighted:

rng.Sort.SortFields.Clear

 

[JackDanIce]

Try:

Sub SortBySub()

    Dim LR          As Long
    Dim rng         As Range
    Dim wks         As Worksheet
    
    LR = Cells(Rows.count, 4).End(xlUp).row
    Set wks = ActiveWorkbook.Worksheets("Calendar")
    Set rng = ActiveCell

    Application.ScreenUpdating = False
        
    With wks
        .Sort.SortFields.Clear
        .Sort.SortFields.add key:=Range("D5:D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
        .Sort.SortFields.add key:=Range("C5:C" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
        .Sort.SortFields.add key:=Range("B5:B" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
        With .Sort
            .SetRange wks.Range("A5:BQ" & LR)
            .header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    
    With Application
        .Goto rng, True
        .ScreenUpdating = True
    End With
    
    Set rng = Nothing
    
End Sub

 

[jmpatrick]

Sorry for the delay!

This is close but the cursor doesn't follow the originally selected row (and most importantly the data it contains), it parks at the original row NUMBER. After sorting the originally selected row has become another row number. I want this macro to follow that original row no matter which number it becomes after the sort.

Make sense?