Transposing data

[Aussiebear]

An earlier thread (which remains unsolved), where a User wanted to reverse a range of columns (A:G), on a new worksheet, got me thinking about how you could go about this. Excel's Transpose doesn't appear to have the capabilities to reverse the order.

I found this to reverse the order of rows from a range.

Sub ReverseRows(Optional rng As range = Nothing, Optional firstRowNum As Long = 1, Optional lastRowNum As Long = -1)
 
    Dim i, firstRowIndex, lastRowIndex As Integer
    
    ' Set default values for dynamic parameters
    If rng Is Nothing Then Set rng = ActiveSheet.UsedRange
    If lastRowNum = -1 Then lastRowNum = rng.Rows.Count
    
    If firstRowNum <> 1 Then
        ' On each loop, cut the last row and insert it before row 1, 2, 3, and so on
        lastRowIndex = lastRowNum
        For i = firstRowNum To lastRowNum - 1 Step 1
            firstRowIndex = i
            rng.Rows(lastRowIndex).EntireRow.Cut
            rng.Rows(firstRowIndex).EntireRow.Insert
        Next
    Else
        ' Same as above, except handle different Insert behavior.
        ' When inserting to row 1, the insertion goes above/outside rng,
        ' thus the confusingly different indices.
        firstRowIndex = firstRowNum
        For i = firstRowNum To lastRowNum - 1 Step 1
            lastRowIndex = lastRowNum - i + 1
            rng.Rows(lastRowIndex).EntireRow.Cut
            rng.Rows(firstRowIndex).EntireRow.Insert
        Next
    End If
  
End Sub

The person who wrote this code obviously hasn't dimmed the variables correctly, and aside from that, what needs to be changed? Alternatively is there another method to skin the cat?

[Aussiebear]

Would this be a version?

Sub ReverseColumns(Optional rng As range = Nothing, Optional firstColNum As Long = 1, Optional lastColNum As Long = -1)
 
    Dim I as Integer, firstColIndex as Integer, lastColIndex As Integer
    
    ' Set default values for dynamic parameters
    If rng Is Nothing Then Set rng = ActiveSheet.UsedRange
    If lastColNum = -1 Then lastColNum = rng.Columns.Count
    
    If firstColNum <> 1 Then
        ' On each loop, cut the last Column and insert it before Column 1, 2, 3, and so on
        lastColIndex = lastColNum
        For i = firstColNum To lastColNum - 1 Step 1
            firstColIndex = i
            rng.Columns(lastColIndex).EntireColumn.Cut
            rng.Columns(firstColIndex).EntireColumn.Insert
        Next
    Else
        ' Same as above, except handle different Insert behavior.
        ' When inserting to Column 1, the insertion goes above/outside rng,
        ' thus the confusingly different indices.
        firstColIndex = firstColNum
        For i = firstColNum To lastColNum - 1 Step 1
            lastColIndex = lastColNum - i + 1
            rng.Columns(lastColIndex).EntireColumn.Cut
            rng.Columns(firstColIndex).EntireColumn.Insert
        Next
    End If
  
End Sub

[georgiboy]

You could also use a dynamic array formula:

=LET(rng,A1:D4,clms,COLUMNS(rng),CHOOSECOLS(rng,SEQUENCE(,clms,clms,-1)))

[Aussiebear]

Georgiboy, just when I thought it was safe to walk in the woods, you hit me with more of this 365 stuff.... It's not as if I have enough to do already.

[Paul_Hossler]

Personally I think manually entering the range to reverse is very error prone and that interacting with the worksheets is lacking performance

I'd use the Selection and arrays

Down side is that only Values get reversed. If you wanted the formats, it'd be a (very) little bit tricker and not as fast

Option Explicit


Sub RevCols()
    Dim aryIn As Variant
    Dim aryTemp() As Variant
    Dim r As Long, c As Long, o As Long
    
    If Not TypeOf Selection Is Range Then Exit Sub
    
    aryIn = Intersect(Selection.Parent.UsedRange, Selection.EntireColumn).Value


    Worksheets("Sheet2").Cells(1, 1).CurrentRegion.Clear


    ReDim aryTemp(LBound(aryIn, 1) To UBound(aryIn, 1), LBound(aryIn, 2) To UBound(aryIn, 2))


    For c = LBound(aryIn, 2) To UBound(aryIn, 2)
        o = LBound(aryIn, 1)
        For r = UBound(aryIn, 1) To LBound(aryIn, 1) Step -1
            aryTemp(o, c) = aryIn(r, c)
            o = o + 1
        Next r
    Next c


    Worksheets("Sheet2").Cells(1, 1).Resize(UBound(aryIn, 1), UBound(aryIn, 2)).Value = aryTemp
End Sub

[Aussiebear]

Personally I think manually entering the range to reverse is very error prone

This all came about because the person who raised this issue, took over a workbook and wanted the new monthly data to be entered in to Column A and all prior data got pushed right each month. So the effort to reverse the ranges was a one off procedure.

...and that interacting with the worksheets is lacking performance.

Paul, you are going to have to explain that one to me....

[Paul_Hossler]

Paul, you are going to have to explain that one to me....

Just that a lot of looping to read data one cell at a time from the WS and then writing one cell at a time to the second WS takes 2 X #rows X #columns operations (not counting the reversing logic)

Just faster to chunk in #rows X # columns as a single Read and after reversing a single write is a lot faster (assuming reversing is same amount of time)

[Aussiebear]

Thank you Paul. The initial code was written almost 20 years ago when the bears were bad.... My understanding is that it was cutting and pasteing 1 row at a time.

[jolivanes]

Am I understanding you right that you want to have column G as first column, column F as second column, column E as third column and so on?

If that is indeed what you have in mind, this should do that.
Obviously, change references as required.

Sub Try_So()
Dim myArr, sh1 As Worksheet, sh2 As Worksheet, i As Long, x As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
x = 1
myArr = sh1.Range("A1:G" & sh1.Cells(Rows.Count, 1).End(xlUp).Row).Value
    For i = UBound(myArr, 2) To LBound(myArr, 2) Step -1
        sh2.Cells(1, x).Resize(UBound(myArr)) = Application.Index(myArr, , i)
        x = x + 1
    Next i
End Sub

Or if you don't like the "x" variable, this should work also.

Sub Try_So_2()
Dim myArr, sh1 As Worksheet, sh2 As Worksheet, i As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
myArr = sh1.Range("A1:G" & sh1.Cells(Rows.Count, 1).End(xlUp).Row).Value
    For i = LBound(myArr, 2) To UBound(myArr, 2)
        sh2.Cells(1, i).Resize(UBound(myArr)) = Application.Index(myArr, , UBound(myArr, 2) + 1 - i)
    Next i
End Sub

[Aussiebear]

Thank you Jolivanes.

[jolivanes]

I know you marked it as solved but just for the future.
The code in Post #1, if I understand everything right, could be changed to:

Sub Reverse_Rows()
Dim myArr, sh1 As Worksheet, sh2 As Worksheet, i As Long, lc As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
lc = Cells(1, Columns.Count).End(xlToLeft).Column    '<----- or however is the proper way to find last used column
myArr = sh1.Range("A1:A" & sh1.Cells(Rows.Count, 1).End(xlUp).Row).Resize(, lc).Value
    For i = LBound(myArr) To UBound(myArr)
        sh2.Cells(i, 1).Resize(, UBound(myArr, 2)) = Application.Index(myArr, UBound(myArr) + 1 - i, 0)
    Next i
End Sub

This will reverse the order of the rows.