I'm trying to write a code that sorts two columns in a worksheet but having difficulties due to there being zeros and blanks.
I need to sort by date (earliest to oldest), then sort the data in terms of premium (largest to smallest but there will be blanks or zero premiums entered).
I'd like the macro to order the sheet so it shows the date (earliest) and then premium (largest) in order.
Here is what I have so far and it's not quite working, please can someone help?
P = date
F = premium values
Range = A2:BA5000 (entries shouldn't exceed this number and it isn't a table)
There will always be something in A3 (this is a policy number, anything entered into the sheet must have a policy number)
The spreadsheet is saved on SharePoint and autosave is on
Sub MultiLevelSort()
Worksheets("Portfolio Tracker").Unprotect Password:="Password"
Worksheets("Portfolio Tracker").Sort.SortFields.Clear
Range("A3", Range("A3").End(xlDown)).Sort Key1:=Range("F3"), Key2:=Range("P3"), Header:=xlYes, _
Order1:=xlAscending, Order2:=xlDescending
Worksheets("Portfolio Tracker").Protect Password:="Password", AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, DrawingObjects:=True, Scenarios:=False, AllowDeletingRows:=True
End Sub
Any help would be amazing as it's driving me crazy.
The Before and the After
The Code
Option Explicit
Sub MultiLevelSort()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Portfolio Tracker")
ws.Unprotect Password:="Password"
If ws.AutoFilterMode Then ws.AutoFilterMode = False
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim rg As Range: Set rg = ws.Range("A3", ws.Cells(lRow, "BA"))
ws.Sort.SortFields.Clear
rg.Sort Key1:=rg.Columns(6), Order1:=xlAscending, _
Key2:=rg.Columns(16), Order2:=xlDescending, _
Header:=xlNo
ws.Protect Password:="Password", AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, DrawingObjects:=True, Scenarios:=False, _
AllowDeletingRows:=True
End Sub