CODEWITHSUNDEEP
excelvba
Malamare
Malamare

Reputation: 27

Reverse rows of a range

I have to reverse the rows of a range. The code I have written reverts a range of 1000 rows x 1000 columns in 2 min, 18 s, 587 ms. Can someone provide a faster code?

Average time 1000 rows x 1000 columns : 2 min, 18 s, 587 ms

(Intel i7-6700 4 GHz, 32 GB RAM) (Windows 10 Home x64) (Excel Office 365 MSO(16.0.11328.20144) 32 bits)

I do not need to turn calculation off, cells do not have formulas. GMalc code is short and very fast: 8s, 23 ms but @Rory suggestion is faster as Ron said: 1s, 195 ms !!! Thanks

Sub InvertRangeRows(ByRef rngRange_IO As Range)

Dim RowI&, RowRange&, RowArray&, RowFirst As Long
Dim RowLast&, ColumnFirst&, ColumnLast As Long
Dim ArrayRange As Variant, ArrayInverted As Variant
Dim RowCurrent As Variant

Application.ScreenUpdating = False

ArrayRange = rngRange_IO
ReDim ArrayInverted(1 To UBound(ArrayRange))

For RowI = UBound(ArrayRange) To LBound(ArrayRange) Step -1
    RowCurrent = Application.WorksheetFunction.Index(ArrayRange, RowI, 0)
    RowRange = RowRange + 1
    ArrayInverted(RowRange) = RowCurrent
Next RowI

With rngRange_IO
    RowFirst = .Row
    RowLast = RowFirst + UBound(ArrayRange) - 1
    ColumnFirst = .Column
    ColumnLast = ColumnFirst + UBound(ArrayRange, 2) - 1
End With

With rngRange_IO.Worksheet
    For RowI = RowFirst To RowLast
        RowArray = RowArray + 1
        .Range(.Cells(RowI, ColumnFirst), .Cells(RowI, ColumnLast)) _
          = ArrayInverted(RowArray)
    Next RowI
End With

Application.ScreenUpdating = False

End Sub

Upvotes: 1

Views: 398

Answers (2)

Malamare
Malamare

Reputation: 27

I share the code according to the suggestion of @Rory and Ron Rosenfeld. I have included turn calculation off so that it allows to include formulas. This is the fastest code: 1.2 s vs 2'18.6" of my first code !!! Thank you

Sub InvertRangeRows(ByRef rngRange_IO As Range)
Dim RowI&, RowCurrent&, ColumnI As Long
Dim ArrayRange As Variant, ArrayInverted As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

ArrayRange = rngRange_IO
ReDim ArrayInverted(1 To UBound(ArrayRange), 1 To UBound(ArrayRange, 2))

For RowI = UBound(ArrayRange) To 1 Step -1
    RowCurrent = RowCurrent + 1
    For ColumnI = 1 To UBound(ArrayRange, 2)
        ArrayInverted(RowCurrent, ColumnI) = ArrayRange(RowI, ColumnI)
    Next ColumnI
Next RowI

rngRange_IO = ArrayInverted

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Upvotes: 0

GMalc
GMalc

Reputation: 2628

This code is not much faster (1k x 1k) in 1 min 28 sec, but is easier.

Dim ws As Worksheet, lRow As Long, i As Long

Set ws = ThisWorkbook.Worksheets("Sheet1")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

Application.Calculation = xlCalculationManual
    For i = 2 To lRow
        ws.Cells(i, 1).EntireRow.Cut
        ws.Cells(1, 1).EntireRow.Insert Shift:=xlDown
    Next i
Application.Calculation = xlCalculationAutomatic

Upvotes: 1

Related Questions