On-screen guidance at the moment of need enables you & your employees to focus on the core, you can now boost your adoption rates swiftly and simply with one easy tool.
Become a Premium Member and unlock a new, free course in leading technologies each month.
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Public Sub cmdSort_Click()
Dim wks As Worksheet
Dim wkb As Workbook
Dim rngToSort As Range
Dim keyRng As Range
Dim nextSort As Range
Dim helpSortCol As Range
Dim originalSort As Range
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Sheet1")
'Sort first section
wks.Sort.SortFields.Clear
Set rngToSort = wks.Range(wks.Range("A1"), wks.Range("A1").End(xlToRight).End(xlDown))
Set keyRng = Range(wks.Range("A1").End(xlToRight).Offset(1, 0), wks.Range("A1").End(xlToRight).Offset(1, 0).End(xlDown))
Set originalSort = wks.Range(wks.Range("A2"), wks.Range("A2").End(xlDown))
rngToSort.Sort Key1:=keyRng, Order1:=xlDescending, Header:=xlNo
'sort second, third, and any other subsequent sections
Set nextSort = wks.Range("A1").End(xlDown).End(xlDown) 'assumes next section separated by at least one blank line
While nextSort.row <> wks.Range("A" & wks.Rows.Count).row
Set nextSort = wks.Range(nextSort, nextSort.End(xlToRight).End(xlDown))
'create helper column from original sort
Set helpSortCol = nextSort.End(xlToRight).Offset(, 1).Resize(nextSort.Rows.Count)
helpSortCol.Cells(1, 1).Formula = "=MATCH(A" & helpSortCol.Cells(1, 1).row & "," & originalSort.Address & ",0)"
helpSortCol.FillDown
'now sort the section
Set rngToSort = Union(nextSort, helpSortCol) 'use the helper (last column) to sort
rngToSort.Sort Key1:=helpSortCol, Order1:=xlAscending, Header:=xlNo
'cleanup helpercolumn
helpSortCol.ClearContents
'setup for next sort, until done
Set nextSort = nextSort.End(xlDown).End(xlDown)
Wend
End Sub
See attached demo workbook.Public Sub cmdSort_Click()
Dim wks As Worksheet
Dim wkb As Workbook
Dim rngToSort As Range
Dim keyRng As Range
Dim nextSort As Range
Dim helpSortCol As Range
Dim originalSort As Range
Dim xCalc As Long
xCalc = Application.Calculation
Application.Calculation = xlCalculationAutomatic
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Sheet1")
'Sort first section
wks.Sort.SortFields.Clear
Set rngToSort = wks.Range(wks.Range("A1"), wks.Range("A1").End(xlToRight).End(xlDown))
Set keyRng = Range(wks.Range("A1").End(xlToRight).Offset(1, 0), wks.Range("A1").End(xlToRight).Offset(1, 0).End(xlDown))
Set originalSort = wks.Range(wks.Range("B2"), wks.Range("B2").End(xlDown)) ' sort by category
rngToSort.Sort Key1:=keyRng, Order1:=xlDescending, Header:=xlNo
'sort second, third, and any other subsequent sections
Set nextSort = wks.Range("A1").End(xlDown).End(xlDown) 'assumes next section separated by at least one blank line
While nextSort.row <> wks.Range("A" & wks.Rows.Count).row
Set nextSort = wks.Range(nextSort, nextSort.End(xlToRight).End(xlDown))
'create helper column from original sort
Set helpSortCol = nextSort.End(xlToRight).Offset(, 1).Resize(nextSort.Rows.Count)
helpSortCol.Cells(1, 1).Formula = "=MATCH(B" & helpSortCol.Cells(1, 1).row & "," & originalSort.Address & ",0)" 'sort by category
helpSortCol.FillDown
'now sort the section
Set rngToSort = Union(nextSort, helpSortCol) 'use the helper (last column) to sort
rngToSort.Sort Key1:=helpSortCol, Order1:=xlAscending, Header:=xlNo
'cleanup helpercolumn
helpSortCol.ClearContents
'setup for next sort, until done
Set nextSort = nextSort.End(xlDown).End(xlDown)
Wend
Application.Calculation = xCalc
End Sub
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.