Reorder columns in Array I am reordering columns in an array and removing one column. The mapping is as follows:

| Item   | In index | Out Index |
|--------|----------|-----------|
| Item1  | 1        | 6         |
| Item2  | 2        | 4         |
| Item3  | 3        | 5         |
| Item4  | 4        | 7         |
| Item5  | 5        | 8         |
| Item6  | 6        | 9         |
| Item7  | 7        | 10        |
| Item8  | 8        | #N/A      |
| Item9  | 9        | 1         |
| Item10 | 10       | 2         |
| Item11 | 11       | 3         |


So, with the following data in range A1:K2 of the active sheet:

| Category 1 | RX9 | East Midlands | 4588 | 14:47:36 | 00:08:25 | 00:14:52 |   | 01/10/17 | 09/02/18 | England |
|------------|-----|---------------|------|----------|----------|----------|---|----------|----------|---------|
| Category 1 | RX9 | East Midlands | 4588 | 14:47:36 | 00:08:25 | 00:14:52 |   | 01/10/17 | 09/02/18 | England |


I get, after running the code:

| 01/10/17 | 09/02/18 06:09 | England | RX9 | East Midlands | Category 1 | 4588 | 0.616388889 | 0.005844907 | 0.010324074 |
|----------|----------------|---------|-----|---------------|------------|------|-------------|-------------|-------------|
| 01/10/17 | 09/02/18 06:09 | England | RX9 | East Midlands | Category 1 | 4588 | 0.616388889 | 0.005844907 | 0.010324074 |


Notes: 


I don't expect the array number of rows to ever exceed 12,240.
The time columns have become doubles in the output. Sorted with code to format the relevant columns - not pertinent to question.


Is there a more efficient way to do this without making arrays left, right and centre?

Option Explicit
Public Const OutputColumnsTotal As Long = 10

Private Sub test()

    Dim tempArr() As Variant

    With ActiveSheet

        tempArr = .Range("A1:K2").Value
        tempArr = ShuffleArrayColumns(tempArr)

        .Range("A5").Resize(UBound(tempArr, 1), UBound(tempArr, 2)) = tempArr

    End With

End Sub

Private Function ShuffleArrayColumns(ByRef tempArr As Variant) As Variant

    If Not UBound(tempArr, 2) - 1 = OutputColumnsTotal Then

        Debug.Print "Array tempArr as wrong # columns in " &amp; Application.VBE.Activecodepane.CodeModule
        Exit Function

    Else

        Dim i As Long
        Dim tempArr2() As Variant
        ReDim tempArr2(1 To UBound(tempArr, 1), 1 To OutputColumnsTotal)

        For i = LBound(tempArr, 1) To UBound(tempArr, 1)

            tempArr2(i, 1) = Format$(tempArr(i, 9),"yyyy-mm-dd") 'to preserve UK date format. Sheet is formatted to display "mmm-yy".
            tempArr2(i, 2) = tempArr(i, 10)
            tempArr2(i, 3) = tempArr(i, 11)
            tempArr2(i, 4) = tempArr(i, 2)
            tempArr2(i, 5) = tempArr(i, 3)
            tempArr2(i, 6) = tempArr(i, 1)
            tempArr2(i, 7) = tempArr(i, 4)
            tempArr2(i, 8) = tempArr(i, 5)
            tempArr2(i, 9) = tempArr(i, 6)
            tempArr2(i, 10) = tempArr(i, 7)

        Next i

    End If

    ShuffleArrayColumns = tempArr2

End Function
Another approach is to work with individual columns:

Option Explicit

Public Sub ShuffleColumns()

    Const ROW_OFFSET As Long = 3

    Dim fr As Long, fc As Long, lr As Long, frx As Long, lrx As Long
    Dim res As Variant, arr As Variant, i As Long

    With Sheet1

        fr = .UsedRange.Row
        fc = .UsedRange.Column
        lr = .Cells(fr, fc).End(xlDown).Row

        frx = lr + ROW_OFFSET   'Next first row
        lrx = (frx - fr) + lr   'Next last row

        res = Array(9, 10, 11, 2, 3, 1, 4, 5, 6, 7) 'IN columns mapped to OUT columns

        fc = fc - 1 'Optimized for the loop

        For i = LBound(res) To UBound(res)

            arr = .Range(.Cells(fr, res(i) + fc), .Cells(lr, res(i) + fc))  'IN column

           .Range(.Cells(frx, i + 1 + fc), .Cells(lrx, i + 1 + fc)) = arr   'OUT column

        Next

       .Range(.Cells(frx, fc + 1), .Cells(lrx, fc + 1)).NumberFormat = "yyyy-mm-dd"

    End With
End Sub


.

Note: Public Const OutputColumnsTotal As Long = 10 is global but it is used only in ShuffleArrayColumns() - it's advisable to declare constants and vars as close to their scope as possible

.

Test results with OP code:



Test results with this code:



Performance: for 100,000 rows - 2.167 sec (OP code) vs 1.277 sec (this code)



Edit

Testing with different optimizations for the FOR loop:

Version 2

Public Sub ShuffleColumnsUnoptimizedFC()
    Const ROW_OFFSET As Long = 3

    Dim fr As Long, fc As Long, lr As Long, frx As Long, lrx As Long
    Dim res As Variant, arr As Variant, i As Long, t As Double
    With Sheet1
        t = Timer
        fr = .UsedRange.Row
        fc = .UsedRange.Column
        lr = .Cells(fr, fc).End(xlDown).Row

        frx = lr + ROW_OFFSET
        lrx = (frx - fr) + lr

        res = Array(9, 10, 11, 2, 3, 1, 4, 5, 6, 7)
        For i = LBound(res) To UBound(res)
            arr = .Range(.Cells(fr, res(i) + fc - 1), .Cells(lr, res(i) + fc - 1))
           .Range(.Cells(frx, i + 1 + fc - 1), .Cells(lrx, i + 1 + fc - 1)) = arr
        Next
       .Range(.Cells(frx, fc), .Cells(lrx, fc)).NumberFormat = "yyyy-mm-dd"
        Debug.Print "Rows: " &amp; lr &amp; "; Time: " &amp; Format("0.000", Timer - t) &amp; " sec"
    End With
End Sub




Version 3

Public Sub ShuffleColumnsUnoptimizedLoop()
    Const ROW_OFFSET As Long = 3

    Dim fr As Long, fc As Long, lr As Long, frx As Long, lrx As Long
    Dim res As Variant, arr As Variant, i As Long, t As Double
    With Sheet1
        t = Timer
        fr = .UsedRange.Row
        fc = .UsedRange.Column
        lr = .Cells(fr, fc).End(xlDown).Row

        frx = lr + ROW_OFFSET
        lrx = (frx - fr) + lr

        res = Array(9, 10, 11, 2, 3, 1, 4, 5, 6, 7)
        For i = LBound(res) To UBound(res)
            arr = .Range(.Cells(fr, res(i) + fc - 1), .Cells(lr, res(i) + fc - 1))
           .Range(.Cells(frx, i + 1 + fc - 1), .Cells(lrx, i + 1 + fc - 1)) = arr
            If i = 1 Then
                .Range(.Cells(frx, fc), .Cells(lrx, fc)).NumberFormat = "yyyy-mm-dd"
            End If
        Next
        Debug.Print "Rows: " &amp; lr &amp; "; Time: " &amp; Format("0.000", Timer - t) &amp; " sec"
    End With
End Sub


After 3 tests with 500,000 rows

Rows: 500,000; Time: 7.01171875 sec (v1)
Rows: 500,000; Time: 7.05078125 sec (v2)
Rows: 500,000; Time: 7.08984375 sec (v3)




The idea is to move all unnecessary operations outside the loop - repetition will amplify any minor effort - exponentially if the loops are nested.