Sort columns by header name but if header name not present then sort by other header names-CodePudding

I have some person data that I need VBA to sort by header name, but sometimes one of the headers isn't there and I need it to skip the block of code and sort by different header names. Also, I could only figure out how to do three columns and not four so if someone can help me figure that out too that would be amazing!

I need it to sort ascending:

Grade, Teacher, Last Name, First Name -OR- Grade, Last Name, First Name

   Dim Fnd(1 To 3) As Range
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Array("Grade", "Teacher", "Last Name")
   For i = 1 To 3
      Set Fnd(i) = Range("1:1").Find(Ary(i - 1), , , xlWhole, , , False, , False)
   Next i
   Range("A1").CurrentRegion.Sort _
   key1:=Fnd(1), order1:=xlAscending, _
   key2:=Fnd(2), order2:=xlAscending, _
   key3:=Fnd(3), order3:=xlAscending, _
   Header:=xlYes

CodePudding user response：

Something like this should work:

Dim SortColumns As Variant
SortColumns = Array("Grade", "Teacher", "Last Name", "First Name")  'define all columns to sort by

With ThisWorkbook.Worksheets("Sheet1")  'specify your sheet here
    .Sort.SortFields.Clear
    
    Dim RngFound As Range
    Dim SortColumn As Variant
    For Each SortColumn In SortColumns
        Set RngFound = Nothing
        Set RngFound = .Range("1:1").Find(SortColumn, , , xlWhole, , , False, , False)
        
        If Not RngFound Is Nothing Then  ' add to sortfields if header was found
            .Sort.SortFields.Add2 Key:=RngFound.EntireColumn, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End If
    Next SortColumn
    
    .Sort.SetRange .Range("A1").CurrentRegion
    .Sort.Header = xlYes
    .Sort.MatchCase = False
    .Sort.Orientation = xlTopToBottom
    .Sort.SortMethod = xlPinYin
    .Sort.Apply
End With

It will sort by all 4 fields if they exist and just ignore the ones that do not exist.

CodePudding user response：

Range.Sort is limited to 3 keys at once, but you can sort multiple times and use different columns each time. You would put these in reverse order, because the final sort will override the previous sorts.

Here's how I would do it:

Sub HeaderSort()
    Dim ws As Worksheet
        Set ws = ActiveSheet

    Dim HeaderLabels As Variant
    HeaderLabels = Array("Grade", "Teacher", "Last Name", "First Name")
    
    Dim HCols() As Range, i As Long
    ReDim HCols(LBound(HeaderLabels) To UBound(HeaderLabels))
    For i = LBound(HeaderLabels) To UBound(HeaderLabels)
        Set HCols(i) = ws.Rows(1).Find(HeaderLabels(i), , , xlWhole, , , False, , False)
    Next i
    
    If HCols(1) Is Nothing Then 'Teacher header not found
        ws.Range("A1").CurrentRegion.Sort _
            key1:=HCols(0), order1:=xlAscending, _
            key2:=HCols(2), order2:=xlAscending, _
            key3:=HCols(3), order3:=xlAscending, _
            Header:=xlYes
        
    Else 'All 4 headers found
        'Sort the 4th, least priority header first
        ws.Range("A1").CurrentRegion.Sort key1:=HCols(3), order1:=xlAscending, Header:=xlYes
        
        'Sort the other three
        ws.Range("A1").CurrentRegion.Sort _
            key1:=HCols(0), order1:=xlAscending, _
            key2:=HCols(1), order2:=xlAscending, _
            key3:=HCols(2), order3:=xlAscending, _
            Header:=xlYes
    End If
End Sub