Private Sub Sorter()
Dim xlSort As XlSortOrder
Dim LastRow As Long
Dim aCell As Range
Dim rng As Range
Dim Loc As Range
Set Loc = Selection
Set aCell = ActiveCell
With ActiveSheet
LastRow = .Cells(.Rows.Count, Loc).End(xlUp).Row
Set rng = Range(aCell).Resize(LastRow, 1)
With rng
If (.Cells(1).Value > .Cells(LastRow - 1).Value) Then
xlSort = xlAscending
Else
xlSort = xlDescending
End If
.Sort Key1:=.Cells(1), Order1:=xlSort, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End With
End Sub
Option Explicit
Sub Sort() 'Ctrl + Shift + S
Dim oneRange As Range
Dim aCell As Range
Set oneRange = Selection
Set aCell = ActiveCell
ActiveWorkbook.Unprotect
ActiveSheet.Unprotect
Application.EnableEvents = False
oneRange.Sort Key1:=aCell, Order1:=xlAscending, Header:=xlGuess
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:= _
True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:= _
True
ActiveWorkbook.Protect Structure:=True, Windows:=False
End Sub
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.
”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.
Our community of experts have been thoroughly vetted for their expertise and industry experience.