Automatically reordering columns

[Hewso]

Hi, I'm struggling to find any solution and hoping there is one. Can I reorder columns based on an order in another list? For example I currently have columns ordered A,B,C,D,E,F but the list i want it to reference tells me the order should be B,E,A,F,C,D. I don't want to have to manually reorder columns every time as it's over 30 columns and is a regular report. Thanks for any help

 

[Yongle]

Welcome to MrExcel

Here is one very simple way
Insert 2 rows at the TOP of your sheet
Row1 contains the numbers from 1 (in column A) to 34 in column AH (if that is last column used)
Row2 contains alternative sort (make sure that each number only appears ONCE!!)
Row3 contains data headers, row4 is where the data starts (see picture)

Sub SortOnRow(aRow As Long)
    Dim x As Long: x = Cells(1, Columns.Count).End(xlToLeft)
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Cells(aRow, 1).Resize(, x), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With
    With ActiveSheet.Sort
        .SetRange Range("A:A").Resize(, x)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Call the sub like this
When the input box pops up... enter 1 to sort based on row1, enter 2 to sort based on row2

Sub CallSub()
    On Error Resume Next
    Call SortOnRow(InputBox("1 or 2", "Rearrange Columns", 1))
    On Error GoTo 0
End Sub