VBA - button to sort by date in ascending and descending order

[AT_TreeFortConsulting]

Hi all -
I recorded a macro to sort a table by oldest to newest date using a button, and would like to have it sort by newest to oldest if I click the button a second time, but don't know how to get to the second part. Below is what I recorded to sort oldest to newest:

' sort_by_date Macro
'

'
ActiveWorkbook.Worksheets("Daily Activity").ListObjects("tbl_daily_tracker"). _
Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Daily Activity").ListObjects("tbl_daily_tracker"). _
Sort.SortFields.Add2 Key:=Range("tbl_daily_tracker[Date]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Daily Activity").ListObjects("tbl_daily_tracker"). _
Sort.SortFields.Add2 Key:=Range("tbl_daily_tracker[Activity]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Daily Activity").ListObjects( _
"tbl_daily_tracker").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

 

[Micron]

You didn't post the beginning line, so I have to guess. Create a private module level variable e.g. strSort. When you sort one way (ASC), your code should set the value to the opposite DESC. At the beginning of your code start an IF block that checks the value of strSort. If it has no value (other than an empty string) OR if its value is DESC sort ASC. Otherwise, sort DESC.

Please post code within code tags to maintain indentation and readability (use vba button on posting toolbar).

EDIT - DESC and ASC are Access vba functions but same idea. Use Excel sort commands instead.

 

[AT_TreeFortConsulting]

You didn't post the beginning line, so I have to guess. Create a private module level variable e.g. strSort. When you sort one way (ASC), your code should set the value to the opposite DESC. At the beginning of your code start an IF block that checks the value of strSort. If it has no value (other than an empty string) OR if its value is DESC sort ASC. Otherwise, sort DESC.

Please post code within code tags to maintain indentation and readability (use vba button on posting toolbar).

EDIT - DESC and ASC are Access vba functions but same idea. Use Excel sort commands instead.

Sorry, I didn't realize I missed the first line. I added below within the VBA code:

Sub sort_by_date()
'
' sort_by_date Macro
'

'
    ActiveWorkbook.Worksheets("Daily Activity").ListObjects("tbl_daily_tracker"). _
        Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Daily Activity").ListObjects("tbl_daily_tracker"). _
        Sort.SortFields.Add2 Key:=Range("tbl_daily_tracker[Date]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Daily Activity").ListObjects("tbl_daily_tracker"). _
        Sort.SortFields.Add2 Key:=Range("tbl_daily_tracker[Activity]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Daily Activity").ListObjects( _
        "tbl_daily_tracker").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[Micron]

Macro recorder will repeat things and add a lot of fluff. I think it might work as below. Note that I'm not as savvy with Excel vba as with Access so perhaps the variable won't work as I've used it for the sort parameter. Hopefully you'll get the drift re: using the IF block to evaluate the value of the sorting variable and manage to adapt to suit your workbook. I tried to condense, partly by way of using the variable when applying the sorting. If that doesn't work then it can be modified. Don't forget that the variable must be declared at the top of the module, right under Option Explicit, which I hope you're using.

Dim strSort As String

Sub SortByDate

If strSort = "" Or strSort = "xlDescending" Then
    strSort = "xlAscending"
Else
    strSort = "xlDescending"
End if

With ActiveWorkbook.Worksheets("Daily Activity").ListObjects("tbl_daily_tracker")
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=Range("tbl_daily_tracker[Date]"), SortOn:=xlSortOnValues, _
     Order:=strSort, DataOption:=xlSortNormal
    .Sort.SortFields.Add2 Key:=Range("tbl_daily_tracker[Activity]"), SortOn:=xlSortOnValues, _
     Order:=strSort, DataOption:=xlSortNormal
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply    
End With

End Sub

EDIT - what I don't understand about your code is why 2 different columns are being sorted on in the same procedure. At least that's how it looks to me. Maybe during the recording, you changed your mind?

 

[Peter_SSs]

See if this does what you want.

Sub sort_by_date_v2()
  Dim sf As Variant
  Dim sort_order As Long
  
  With ActiveWorkbook.Worksheets("Daily Activity").ListObjects("tbl_daily_tracker").Sort
    Set sf = .SortFields
    sort_order = 1
    On Error Resume Next
    sort_order = 3 - sf.Item(1).Order
    On Error GoTo 0
    sf.Clear
    sf.Add2 Key:=Range("tbl_daily_tracker[Date]"), SortOn:=xlSortOnValues, Order:=sort_order, DataOption:=xlSortNormal
    sf.Add2 Key:=Range("tbl_daily_tracker[Activity]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
End Sub

 

[AT_TreeFortConsulting]

See if this does what you want.

Sub sort_by_date_v2()
  Dim sf As Variant
  Dim sort_order As Long
 
  With ActiveWorkbook.Worksheets("Daily Activity").ListObjects("tbl_daily_tracker").Sort
    Set sf = .SortFields
    sort_order = 1
    On Error Resume Next
    sort_order = 3 - sf.Item(1).Order
    On Error GoTo 0
    sf.Clear
    sf.Add2 Key:=Range("tbl_daily_tracker[Date]"), SortOn:=xlSortOnValues, Order:=sort_order, DataOption:=xlSortNormal
    sf.Add2 Key:=Range("tbl_daily_tracker[Activity]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
End Sub

Yes - this works, thank you so much!

 

[Peter_SSs]

Glad it worked for you. Thanks for the follow-up.