Custom Sorting VBA

[eli_m]

Hi,

I manually have my custom sorting as:
Column B (Surgery Date) - Oldest to Newest
then
Column F (Surgeon) - A to Z

Currently, I have the code below to sort by the Surgery Date by Oldest to Newest which has been working great but how do I add Column F (Surgeon) - A to Z as the secondary sort?

This is my current code:

Option Explicit
Private Sub Workbook_Open()

    If ActiveSheet.Name = Sheet1.Name Then
    'Start Timeout Timer
        checktime = False
        Call checktimer
    'Check Timeout timer
        checktime = True
        Lastchange = Now()
     End If
  
  
  Dim cel As Range
 
  Application.ScreenUpdating = False
  ThisWorkbook.RefreshAll
  With Sheets("IPS Cases")
    On Error Resume Next
    ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
    On Error GoTo 0
    For Each cel In .Range("A2:BP200")
      With cel
        .Errors(8).Ignore = True
        .Errors(9).Ignore = True
        .Errors(6).Ignore = True
      End With
    Next cel
  End With
  Application.ScreenUpdating = True
End Sub

Thank you in advance

 

[kvsrinivasamurthy]

In this line

ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _

add Key2:= and Order2:= after Order1

 

[eli_m]

In this line

ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _

add Key2:= and Order2:= after Order1

Thanks! I think this did the trick:

Option Explicit
Private Sub Workbook_Open()

    If ActiveSheet.Name = Sheet1.Name Then
    'Start Timeout Timer
        checktime = False
        Call checktimer
    'Check Timeout timer
        checktime = True
        Lastchange = Now()
     End If
   
   
  Dim cel As Range
 
  Application.ScreenUpdating = False
  ThisWorkbook.RefreshAll
  With Sheets("IPS Cases")
    On Error Resume Next
    ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _
Key2:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), Order2:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
    On Error GoTo 0
    
    For Each cel In .Range("A2:AR200") 'Ignore ALL Errors
      With cel
        .Errors(6).Ignore = True 'Lock Error
        .Errors(7).Ignore = True 'Unprotected Forumla Error
        .Errors(8).Ignore = True 'Data Validation Error
        .Errors(9).Ignore = True 'Inconsistent Error
        .Errors(10).Ignore = True 'Inconsistent Calculated Column Formula Error
      End With
      
    Next cel
  End With
  Application.ScreenUpdating = True
End Sub

 

[eli_m]

Thanks! I think this did the trick:

Option Explicit
Private Sub Workbook_Open()

    If ActiveSheet.Name = Sheet1.Name Then
    'Start Timeout Timer
        checktime = False
        Call checktimer
    'Check Timeout timer
        checktime = True
        Lastchange = Now()
     End If
  
  
  Dim cel As Range
 
  Application.ScreenUpdating = False
  ThisWorkbook.RefreshAll
  With Sheets("IPS Cases")
    On Error Resume Next
    ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _
Key2:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), Order2:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
    On Error GoTo 0
   
    For Each cel In .Range("A2:AR200") 'Ignore ALL Errors
      With cel
        .Errors(6).Ignore = True 'Lock Error
        .Errors(7).Ignore = True 'Unprotected Forumla Error
        .Errors(8).Ignore = True 'Data Validation Error
        .Errors(9).Ignore = True 'Inconsistent Error
        .Errors(10).Ignore = True 'Inconsistent Calculated Column Formula Error
      End With
     
    Next cel
  End With
  Application.ScreenUpdating = True
End Sub

Whoops. Sorry:

Option Explicit
Private Sub Workbook_Open()

    If ActiveSheet.Name = Sheet1.Name Then
    'Start Timeout Timer
        checktime = False
        Call checktimer
    'Check Timeout timer
        checktime = True
        Lastchange = Now()
     End If
   
   
  Dim cel As Range
 
  Application.ScreenUpdating = False
  ThisWorkbook.RefreshAll
  With Sheets("IPS Cases")
    On Error Resume Next
    ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _
Key2:=ThisWorkbook.Sheets("IPS Cases").Range("F3"), Order2:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
    On Error GoTo 0
    
    For Each cel In .Range("A2:AR200") 'Ignore ALL Errors
      With cel
        .Errors(6).Ignore = True 'Lock Error
        .Errors(7).Ignore = True 'Unprotected Forumla Error
        .Errors(8).Ignore = True 'Data Validation Error
        .Errors(9).Ignore = True 'Inconsistent Error
        .Errors(10).Ignore = True 'Inconsistent Calculated Column Formula Error
      End With
      
    Next cel
  End With
  Application.ScreenUpdating = True
End Sub

Changed B to F:
Key2:=ThisWorkbook.Sheets("IPS Cases").Range("F3"), Order2:=xlAscending, Header:=xlYes, _