My Sort date code advice please

[ipbr21054]

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.

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

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

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

 

[dmt32]

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

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]

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]

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

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

 

[ipbr21054]

Many thanks again.