Home > Enterprise >  Sorting data by multiple columns with zeros and blanks
Sorting data by multiple columns with zeros and blanks

Time:07-12

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.

CodePudding user response:

Sort a Range

The Before and the After

enter image description here

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.FilterMode Then ws.ShowAllData

    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
  • Related