Reorder columns in Array

Question

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

• user109261: 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.
• QHarr: 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.
• user109261: 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".
• QHarr: @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.
• user109261: 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.

Answer 1

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:

OP Code

Test results with this code:

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.

• user109261: 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.
• Raystafarian: @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.
• QHarr: @PaulBica I will been running these tomorrow and feedback. Many thanks for your time.
• QHarr: Very quick solution. Much obliged.
• QHarr: What was this line for fc = fc - 1 'Optimized for the loop please?

Answer 2

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

• user109261: 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
• QHarr: 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.
• Raystafarian: @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: @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.
• QHarr: In the many subs and functions in my project I have existing funcs for this. I enjoyed your ingredients project btw!