# 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:

1. I don't expect the array number of rows to ever exceed 12,240.

2. 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 " & 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

• You shouldn't convert the date value into a text value. It is better to format the columns after you write the data back to the spreadsheet. – user109261 Feb 10 '18 at 20:13
• I am sometimes getting US formats written out to the sheet if I don't do that. I can't format the column after to be UK as it won't always know which should be converted. I would have to assume they are always US and re-arrange the characters in the sheet? A UK format goes into the array, but when transferring between arrays it seems US format kicks in and goes back out to sheet. This doesn't always happen which is weird. Tbh I edited that change in because I suddenly noticed the change. Happy to have advice on how to resolve. It is a pain i usually get around by simply working with strings. – QHarr Feb 10 '18 at 20:20
• You should be able to apply the "yyyy-mm-dd" format to the columns regardless of the Excel version Columns("A").NumberFormat = "yyyy-mm-dd". – user109261 Feb 12 '18 at 1:53
• @ThomasInzina What I am saying is if during the array to array transition #12/02/2018# has become #02/12/2018# how will formatting the sheet with "yyyy-mm-dd" ensure I will have the original #12/02/2018# back as #02/12/2018# would also be recognised as valid. Apologies if I am being more dense than usual on this. – QHarr Feb 12 '18 at 9:19
• I didn't think that you would run into the dd/mm/yyyy issue. You could try using.Range("A1:K2").Value2 and tempArr2(i, 1) = tempArr(i, 9). .Value2 ignores formatting and uses the integer value of the Date. Of course, you will still have to change the Columns format. It would probably be easier to do it your way. – user109261 Feb 12 '18 at 9:38

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: " & lr & "; Time: " & Format("0.000", Timer - t) & " 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: " & lr & "; Time: " & Format("0.000", Timer - t) & " 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.

• The OP's code works because he is using two complete arrays. By swapping columns individually, you are not putting the data in the right order. When i = 0 Column 9 is swapped with Column 1. Then when i = 5 Column 1 (which is the data from Column 9) is swapped with Column 6. – user109261 Feb 12 '18 at 8:59
• @ThomasInzina this type of question is about the only good argument I have for Option Base 1, which I still can't bring myself to use. – Raystafarian Feb 12 '18 at 22:42
• @PaulBica I will been running these tomorrow and feedback. Many thanks for your time. – QHarr Feb 12 '18 at 22:44
• Very quick solution. Much obliged. – QHarr Feb 14 '18 at 14:08
• What was this line for fc = fc - 1 'Optimized for the loop please? – QHarr Feb 14 '18 at 14:12

In my opinion, you aren't too far off with your approach unless you could remap entire arrays without a loop, which as far as I know, you can't. You've done a good thing, bringing everything into an array before using it, instead of miffing around with the sheet. Props to that.

You could use some more constants, and you could shuffle your columns with a loop instead of a list of -

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)
etc


Something like this, but it would probably need some refactoring. Also, more descriptive variable names will make it easier to follow -

Public Sub ArrayShuffle()
Const NUMBER_OF_COLUMNS As Long = 9
Const OLD_COLUMNS As String = "9,10,11,2,3,1,4,5,6,7"
Dim oldColumnArray As Variant
oldColumnArray = Split(OLD_COLUMNS, ",")
Dim oldColumn(NUMBER_OF_COLUMNS) As Long
Dim arrayIndex As Long
For arrayIndex = LBound(oldColumnArray) To UBound(oldColumnArray)
oldColumn(arrayIndex) = CInt(oldColumnArray(arrayIndex))
Next

Dim lastRow As Long
lastRow = GetLast(Sheet1, True)
Dim lastColumn As Long
lastColumn = GetLast(Sheet1, False)

Dim rowIndex As Long
Dim columnIndex As Long

Dim inputArray As Variant
inputArray = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(lastRow, lastColumn))
Dim newArray As Variant
ReDim newArray(UBound(inputArray, 1) - 1, NUMBER_OF_COLUMNS)

For arrayIndex = LBound(inputArray, 2) To UBound(inputArray, 2)
For rowIndex = 1 To lastRow
For columnIndex = 1 To NUMBER_OF_COLUMNS + 1
newArray(rowIndex - 1, columnIndex - 1) = inputArray(rowIndex - 1, oldColumn(columnIndex - 1))
Next
Next
Next

End Sub

Private Function GetLast(ByVal targetSheet As Worksheet, ByVal isRow As Boolean) As Long
If isRow Then
GetLast = targetSheet.Cells(Rows.Count, 1).End(xlUp).Row
Else
GetLast = targetSheet.Cells(1, Columns.Count).End(xlToLeft).Column
End If
End Function

• I like the using an Array to store the column numbers. isRow doesn't sound right to me. Consider borrow a parameter from Range.Find method and writing it like this: Private Function GetLast(ByVal targetSheet As Worksheet, ByVal SearchOrder As XlSearchOrder) As Long – user109261 Feb 12 '18 at 9:11
• This sounds very interesting..... I guess my question is, is this better because you are pulling out the column mapping so this becomes more versatile? One simply adjusts the Const for the column mappings presumably with some check that the in columns are +1 to the out. Speed wise I guess little difference. – QHarr Feb 12 '18 at 9:21
• @ThomasInzina I couldn't think of anything better than isRow - ha. You know how sometimes you're focused and working through something then lose your train of thought and you look back and don't understand exactly what you're trying to do? Yeah. – Raystafarian Feb 12 '18 at 22:37
• @QHarr I wouldn't say this is better. I think yes by pulling out your mapping it's easier to adjust it if anything changes, same goes for all constants, just change it once and it reflects it everywhere. Like I said, putting the data in an array and working off the array is the main thing, and you're doing that already! I do think it's better to avoid the list of all the mappings, that could get unwieldy as you increase the size of your array. Redimensioning your array with 1 to x, I agree, is easier to follow, so I can't say my arrays are better. – Raystafarian Feb 12 '18 at 22:40
• In the many subs and functions in my project I have existing funcs for this. I enjoyed your ingredients project btw! – QHarr Feb 12 '18 at 22:46