ReOrder Columns

Option Base 1
Dim ColList As New Scripting.Dictionary
Sub ReorderColumns()
'Assumes there is is a list of existing column names in row 1 and new in row 2
Dim OutPut()
With ThisWorkbook
With .Sheets("Source")
Cx = .Range("BX1").End(xlToLeft).Column
Rx = .Range("A1000").End(xlUp).Row
SD = .Range("A1").Resize(Rx, Cx)
End With

With .Sheets("Output")
Cx = .Range("BX1").End(xlToLeft).Column
CurrentCols = .Range("A1").Resize(1, Cx)
NewCols = .Range("A2").Resize(1, Cx)
'build dictionary
For idx = 1 To UBound(NewCols, 2)
ColList.Add NewCols(1, idx), idx
Next idx
'Check the source data
For idx = 1 To UBound(SD, 2)
SDX = SD(1, idx)
If Not ColList.Exists(SDX) Then
MsgBox ("Column not included" & SDX)
End If

Next idx

'Reorder data use size ref from Output

Rx = Rx - 1
ReDim OutPut(Rx, Cx)

For rdx = 1 To Rx
For cdx = 1 To Cx
SDX = SD(1, cdx)
newCol = ColList(SDX)
OutPut(rdx, newCol) = SD(rdx + 1, cdx)
Next cdx
Next rdx
.Range("A3").Resize(Rx, Cx) = OutPut

End With
End With

End Sub