Alternative not using Excel 365
"If you have access to Excel 365 and SORTBY formula, then you're in luck."
In addition to the valid answer above a late post intending to help the "not so lucky ones" to solve the question by methods prior to the dynamic Excel 365 features:
Main procedure ReorderBy
using
Sub ReorderBy(data, pattern) ' data: Aug,Nov,Dec,May
With Application
'a) fill 2-dim array with pattern indices and sort it
Dim indices: indices = .Match(data, pattern, 0) ' ~> 8,11,12,5
BubbleSort2Dim indices ' ~> 5,8,11,12
'b) reorder data based on pattern indices
data = Application.Index(pattern, indices, Array(1)) ' ~> May,Aug,Nov,Dec
End With
End Sub
Sub BubbleSort2Dim(arr, Optional colNo As Long = 1)
Dim cnt As Long, nxt As Long, temp
For cnt = LBound(arr) To UBound(arr) - 1
For nxt = cnt + 1 To UBound(arr)
If arr(cnt, colNo) > arr(nxt, colNo) Then
temp = arr(cnt, colNo)
arr(cnt, colNo) = arr(nxt, colNo)
arr(nxt, colNo) = temp
End If
Next nxt
Next cnt
End Sub
Example Call
using
[1]
a help function getData()
to get column data and eventually calling
[2]
the main routine ReorderBy
:
ad [1]
) Note that the worksheet argument in getData()
is passed here as CodeName reference (e.g. Sheet1
) to the current project.
Sub ExampleCall()
'[1] define data and pattern arrays
Dim data: data = getData(Sheet1, "A") '[A2:A5]
Dim pattern: pattern = getData(Sheet1, "B") '[B2].Resize(12))
'[2] reorder data
ReorderBy data, pattern ' << call main routine (By Ref arguments!)
'[3] write results to any target
Sheet1.Range("D2").Resize(UBound(data), 1) = data
End Sub
Function getData(ws As Worksheet, ByVal col, Optional ByVal StartRow& = 2) As Variant()
' Purpose: assign column data to variant array
If IsNumeric(col) Then col = Split(ws.Cells(1, col).Address, "$")(1)
Dim LastRow As Long
LastRow = ws.Range(col & Rows.Count).End(xlUp).Row
getData = ws.Range(col & StartRow & ":" & col & LastRow).Value2
End Function