Advace Sorting Based On Values

[Maxal]

Hi

I get workbooks with three kinds of data in a certain column in every workbook. The data is positive, neutral and negative, i.e., 20, 0, -20, respectively. The values are always in the B column.

I was wondering if a macro can do the following:

1 Sort positive data (highest to lowest) (anything greater than zero)
2 Delete rows of neutral data (0)
3 Sort negative data (lowest to highest) (i.e, -20, -18, -12, -7, etc)


Briefly speaking, sort positive values highest to lowest and negative values lowest to highest in the same column and delete rows with 0 values.


Looking for some help

[Leith Ross]

Hello Maxal,

This macro will sort and delete the rows on the Activesheet of the ActiveWorkbook.

Sub SortingMacro()

    Dim n       As Long
    Dim r       As Long
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        Set Wks = ActiveSheet
        
        Set Rng = Wks.UsedRange.Columns("B:B").Cells
        
            With Wks.Sort
                .SortFields.Clear
                .SortFields.Add Key:=Rng, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SetRange Rng
                .Apply
            End With
                
        Set Cell = Rng.Find(0, , xlValues, xlWhole, xlByRows, xlNext, False, False, False)
        
        If Not Cell Is Nothing Then
            While Cell.Offset(n, 0) = 0: n = n + 1: Wend
            Cell.Resize(n, 1).EntireRow.Delete
            n = 0
        End If
        
        For r = Rng.Rows.Count To 1 Step -1
            If Rng.Cells(r, 1) < 0 Then n = n + 1
        Next r
        
        If n > 0 Then
            Set Rng = Wks.Range(Rng.Cells(n + 1, 1), Rng.Cells(Rng.Rows.Count, 1))
        End If
        
            With Wks.Sort
                .SortFields.Clear
                .SortFields.Add Key:=Rng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SetRange Rng
                .Apply
            End With
        
End Sub