Search code examples
excelvbasortingcolumnsorting

Sorting data by multiple columns with zeros and blanks


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.


Solution

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