auto filter on adding rows

[Paul_Hossler]

I'd do something like this


In standard module

Option Explicit

Sub SortData(ws As Worksheet)

    Dim r As Range, r1 As Range
    
    Application.ScreenUpdating = False
        
    With ws
        
        Set r = .Range("A6").CurrentRegion
        Set r1 = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
    
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=r1.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=r1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=r1.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=r1.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange r
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    
        Set r = .Range("A6").CurrentRegion
    End With
        
    Set r1 = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
        
    With r1
        .HorizontalAlignment = xlCenter
        .Columns(3).NumberFormat = "m/d/yyyy h:mm"
        .Columns(4).NumberFormat = "m/d/yyyy h:mm"
        .Columns(5).Formula = "=IF(OR(C7=0,D7=0),"""",D7-C7)"
        .Columns(5).NumberFormat = "h:mm"
    End With
    Application.ScreenUpdating = False

'    MsgBox "Sorted"

End Sub

In Sheet1 code module

Private Sub Worksheet_Activate()
    Call SortData(Me)
End Sub

Private Sub Worksheet_Deactivate()
    Call SortData(Me)
End Sub