Tweeted twitter.com/StackCodeReview/status/963204242046627840

occurred Feb 13, 2018 at 0:12

corrected transcribe error. If bot spots this as possible answer invalidation please refer to comments. It makes no material difference.

Source Link

edited Feb 12, 2018 at 17:35

QHarr

385
4
17

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

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

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

deleted 45 characters in body

Source Link

edited Feb 12, 2018 at 3:28

Jamal

35.2k
13
134
238

Re-order Reorder columns in Array

I am re-orderingreordering columns in an array and removing one column. The mapping is as follows:

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

All other observations welcome.

Code!

Added typed function for preserving UK date format

Source Link

edited Feb 10, 2018 at 17:30

QHarr

385
4
17

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

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) = tempArr(i, 9)
            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

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

added 93 characters in body

Source Link

edited Feb 10, 2018 at 10:56

QHarr

385
4
17

Loading

forgot to add code!

Source Link

edited Feb 10, 2018 at 10:21

QHarr

385
4
17

Loading

Source Link

asked Feb 10, 2018 at 9:55

QHarr

385
4
17

Loading

Stack Exchange Network

Return to Question

Re-order Reorder columns in Array

Re-order columns in Array

Reorder columns in Array