My Sort date code advice please

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
4,118
Office Version
  1. 2007
Platform
  1. Windows
Hi,

I am using the code supplied below.

All works fine BUT the sorting of the date sorts in the order of old to new from top to bottom of page.
I would also like the option to sort the date from new to old from top of page to bottom.

Originaly i was using the 2 codes also supplied but as you can see in this new code its compressed somewhat.

VBA Code:
Private Sub CommandButton1_Click()
Dim x As Long
Dim ws As Worksheet
Set ws = Sheets("HONDA SHEET")
Dim SortColumn As String

Select Case ComboBox1
Case "VIN NUMBER"
SortColumn = "A"

Case "VEHICLE"
SortColumn = "B"

Case "CUSTOMER"
SortColumn = "C"

Case "YEAR"
SortColumn = "D"

Case "HONDA NUMBER"
SortColumn = "E"

Case "SUPPLIED"
SortColumn = "F"

Case "DATE"
SortColumn = "G"

End Select
If Len(SortColumn) <> 0 Then
Application.ScreenUpdating = False
With ws
If .AutoFilterMode Then .AutoFilterMode = False
x = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A20:G" & x).Sort Key1:=.Cells(2, SortColumn), Order1:=xlAscending, Header:=xlGuess
End With
End If
Unload AtoZHondaSheet
End Sub
Private Sub UserForm_Initialize()
Dim rheadings As Range
Dim cl As Range
Set rheadings = Worksheets("HONDA SHEET").Range("A19:G19")
For Each cl In rheadings
Me.ComboBox1.AddItem cl.Value
Next cl
End Sub


NEW TO OLD

Code:
Private Sub SortDatenewold_Click()
    
    Dim x As Long
    
    Application.ScreenUpdating = False
    
    With Sheets("HONDA LIST")
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        .Range("A3:G" & x).Sort Key1:=Range("G4"), Order1:=xlDescending, Header:=xlGuess
        
    End With
                      
    ActiveWorkbook.Save
    
    Application.ScreenUpdating = True
    Sheets("HONDA LIST").Range("G4").Select
    
End Sub


OLD TO NEW

Code:
Private Sub SortDateoldnew_Click()
    
    Dim x As Long
    
    Application.ScreenUpdating = False
    
    With Sheets("HONDA LIST")
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        .Range("A3:G" & x).Sort Key1:=Range("G4"), Order1:=xlAscending, Header:=xlGuess
        
    End With
                      
    ActiveWorkbook.Save
    
    Application.ScreenUpdating = True
    Sheets("HONDA LIST").Range("G4").Select
    
End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,932
Office Version
  1. 2019
Platform
  1. Windows
Hi,

Untested but try following

Add two OptionButtons to your form and apply captions as follows

  • OptionButton1 Caption =”Ascending
  • OptionButton2 Caption = “Descending
Replace CommandButton1 code with updated code


VBA Code:
Private Sub CommandButton1_Click()
    Dim LastRow As Long, SortColumn As Long
    Dim ws As Worksheet
    Dim SortDirection As XlSortOrder
    
    Set ws = Sheets("HONDA SHEET")
    
    SortColumn = Me.ComboBox1.ListIndex + 1
    SortDirection = IIf(Me.OptionButton1.Value, xlAscending, xlDescending)
    
    If SortColumn <> 0 Then
        Application.ScreenUpdating = False
        With ws
            If .AutoFilterMode Then .AutoFilterMode = False
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Range("A20:G" & LastRow).Sort Key1:=.Cells(2, SortColumn), Order1:=SortDirection, Header:=xlGuess
        End With
    End If
    Unload Me
End Sub

Note: I have guessed that the Combobox1 choices in your Select case statement are in the Selection order shown & have replaced the hard coded values with their listindex value.



Dave
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
4,118
Office Version
  1. 2007
Platform
  1. Windows
Thanks,
Works fine on all columns.
I noticed it will also run if no option button is selected so need to add a msgbox in there
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,932
Office Version
  1. 2019
Platform
  1. Windows
Thanks,
Works fine on all columns.
I noticed it will also run if no option button is selected so need to add a msgbox in there

Hi Glad suggestion worked ok for you.
Should not need a MsgBox just set Default Selection in your Forms initialize event

Add the line shown in BOLD

Rich (BB code):
Private Sub UserForm_Initialize()
Dim rheadings As Range
Dim cl As Range

Me.OptionButton1.Value = True
Set rheadings = Worksheets("HONDA SHEET").Range("A19:G19")
For Each cl In rheadings
Me.ComboBox1.AddItem cl.Value
Next cl

End Sub

Dave
 

Forum statistics

Threads
1,148,324
Messages
5,746,121
Members
423,993
Latest member
Vighper

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top