# Automatically Sort List



## Mrniceguyy (Jan 3, 2023)

I'd like the row with the most recent date to be automatically placed at the bottom of the list. 









This is the VBA Code I was attempting to use.


----------



## kevin9999 (Jan 3, 2023)

Mrniceguyy said:


> This is the VBA Code I was attempting to use.


Where?


----------



## Peter_SSs (Jan 4, 2023)

Mrniceguyy said:


> I'd like the row with the most recent date to be automatically placed at the bottom of the list.


As well as Kevin's question, which "most recent date" are you talking about? The one in the "Hire Date" column or the one in the "Date Last Worked" column?


----------



## Mrniceguyy (Jan 4, 2023)

kevin9999 said:


> Where?


----------



## Mrniceguyy (Jan 4, 2023)

Peter_SSs said:


> As well as Kevin's question, which "most recent date" are you talking about? The one in the "Hire Date" column or the one in the "Date Last Worked" column?


Date Last Worked


----------



## Peter_SSs (Jan 4, 2023)

Your image of the code does not help a great deal as we cannot copy from an image to test. Can you just copy the code from your vba window and paste in a forum post? Select the pasted code and click the VBA code tag icon and that will preserve the code formatting and make it easier for helpers to read/copy etc.







Mrniceguyy said:


> Date Last Worked


Thanks for that clarification.


----------



## kevin9999 (Jan 4, 2023)

This proved a lot trickier than I thought it would be.  The only solution I could come up with was very _clunky _- it involves replacing the blank cells in the Date Last Worked column with -1, then doing the sort, then turning the -1's back to blanks.  There must be a better solution than this, but it does seem to work:


```
Private Sub Worksheet_Change(ByVal Target As Range)       
    If Not Intersect(Target, Me.ListObjects("ot").ListColumns("Date Last Worked").DataBodyRange) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Me.ListObjects("ot").ListColumns("Date Last Worked").DataBodyRange.SpecialCells(xlCellTypeBlanks) = -1
        
        Dim SalesTable As ListObject, SortCol As Range
        Set SalesTable = Me.ListObjects("ot")
        Set SortCol = Me.Range("ot[Date Last Worked]")
        
        With SalesTable.Sort
            .SortFields.Clear
            .SortFields.Add Key:=SortCol, Order:=xlAscending
            .Header = xlYes
            .Apply
        End With
        Me.ListObjects("ot").ListColumns("Date Last Worked").DataBodyRange.Replace -1, ""
         
Continue:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
    End If
End Sub
```


----------



## kevin9999 (Jan 6, 2023)

I have made a couple of tweaks to the code offered in post #7

```
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.ListObjects("ot").ListColumns("Date Last Worked").DataBodyRange) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        
        Dim SalesTable As ListObject, SortCol As Range
        Set SalesTable = Me.ListObjects("ot")
        Set SortCol = Me.Range("ot[Date Last Worked]")
        SortCol.SpecialCells(xlCellTypeBlanks) = -1
        
        With SalesTable.Sort
            .SortFields.Clear
            .SortFields.Add Key:=SortCol, Order:=xlAscending
            .Header = xlYes
            .Apply
        End With
        SortCol.Replace -1, ""
    End If
Continue:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
```


----------

