Cut and Paste Rows, Why So Slow, Trying To Speed Up Performance

Question

I have a small estimating worksheet I have made where you type in line items with a description, quantity and price. As it happens you often want to organize your data. In this case I would like to have the ability to move a range of cells up or down the list. (No data is being deleted, just shifting the range up or down) I am simply trying to cut and paste the data up or down one row at a time. I have an Up Arrow and Down Arrow for users to click on to activate the macro, one for up and one for down.

I have successfully written the macro code to make this happen, however it uses the select command and is very slow. I have used the same code before on another project and it was much faster, almost instant, the only difference that I can think of is that I was selecting the the ENTIRE row. In this particular instance I am only wanting to move the data in Columns B thru N. Columns O thru Y have fixed inputs and cannot be moved.

Below is the working code to move the range up.

Sub MoveUp()
Application.ScreenUpdating = False
ActiveSheet.Unprotect 'Unprotects The Sheet
    If Not Intersect(ActiveCell, Range("B12:F98")) Is Nothing Then 'Makes sure you are within the correct range, cannot move top row up

    Range("B" & ActiveCell.Row & ":" & "N" & ActiveCell.Row).Select 'Selects only area you want to move
    Selection.Rows(Selection.Rows.Count + 1).Insert Shift:=xlDown
    Selection.Rows(1).Offset(-1).Cut Selection.Rows(Selection.Rows.Count + 1)
    Selection.Rows(1).Offset(-1).Delete Shift:=xlUp
    Selection.Offset(-1).Select 'This keeps the cell you moved selected so you can keep moving it without having to reselect

    Else
        MsgBox "You Can't Move That Row Up"
    End If

    Call ResetRanges 'Resets the named ranges
    Call ProtectWorkSheet 'Protects The Sheet
Application.ScreenUpdating = True
End Sub

I wrote an alternative macro without using select, trying to use defined ranges and use offsets to make the shift happen, but it was still just as slow as the above code. Am I missing something?

Sub MoveUpRangeMethod()
Application.ScreenUpdating = False

activerow = ActiveCell.Row
endon = activerow - 1
Set rng = Range("B" & activerow & ":" & "N" & activerow)
Set rng2 = Range("B" & activerow - 1 & ":" & "N" & activerow - 1)
rng3 = ("F" & endon)

rng.Cut
rng2.Insert Shift:=xlDown
Range(rng3).Activate

Application.ScreenUpdating = True
End Sub

Update:

I wrote the macro out another way and it still performs slowly. I think that there is something else behind the scenes causing the slowdown. It could quite possibly be from some bad code I have elsewhere. Below is the new code I tried, again, it works fast in a new sheet, but struggles in the workbook where I need it.

Sub ShiftCellsDown()
Dim ws As Worksheet: Set ws = ThisWorkbook.ActiveSheet
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False

    ws.Range("B" & ActiveCell.Row - 1 & ":" & "N" & ActiveCell.Row - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ws.Range("B" & ActiveCell.Row - 1 & ":" & "N" & ActiveCell.Row - 1).Value = ws.Range("B" & ActiveCell.Row + 1 & ":" & "N" & ActiveCell.Row + 1).Value
    ws.Range("B" & ActiveCell.Row + 1 & ":" & "N" & ActiveCell.Row + 1).Delete Shift:=xlUp
    ws.Range(("F" & ActiveCell.Row - 1)).Activate

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Possible duplicate of [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — 41686d6564 stands w. Palestine, Oct 22 '19 at 15:44
Not a duplicate, I explain the difference further down in the post. — Canaan Zeigler, Oct 22 '19 at 15:52
Try also setting `Application.Calculation = xlCalculationManual` at the beginning of code (and remember to return it to `xlCalculationAutomatic` at the end), just like you do with `ScreenUpdating`. — David Zemens, Oct 22 '19 at 16:04
FWIW `Range(rng3).Activate` is redundant. `rng3` is already a `Range`. Also consider switching off `Application.EnableEvents` and `Calculation`, not just `ScreenUpdating`. — Mathieu Guindon, Oct 22 '19 at 16:10

Xabier · Answer 1 · 2019-10-22T16:24:24.697

How about the following, I've just simplified your code a little and added a couple of lines for better performance:

Sub MoveUpRangeMethod()
Dim ws As Worksheet: Set ws = ThisWorkbook.ActiveSheet
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False

    ws.Range("B" & ActiveCell.Row & ":" & "N" & ActiveCell.Row).Cut
    ws.Range("B" & ActiveCell.Row - 1 & ":" & "N" & ActiveCell.Row - 1).Insert Shift:=xlDown
    ws.Range("F" & ActiveCell.Row - 1).Activate

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

UPDATE:

The following update might help, instead of Cut & Insert Ranges, it assigns the values into Arrays and then passes them values into the desired cells, thus hopefully speeding up the process:

Sub MoveUpRangeMethod()
Dim ws As Worksheet: Set ws = ThisWorkbook.ActiveSheet
Dim Arr() As Variant, Arr2() As Variant ' declare two unallocated arrays.
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False

    If ActiveCell.Row > 2 Then
        Arr = ws.Range("B" & ActiveCell.Row & ":" & "N" & ActiveCell.Row).Value ' Arr is now an allocated array
        Arr2 = ws.Range("B" & ActiveCell.Row - 1 & ":" & "N" & ActiveCell.Row - 1).Value ' Arrw is now an allocated array
        ws.Range("B" & ActiveCell.Row).Resize(UBound(Arr2, 1), UBound(Arr2, 2)).Value = Arr2
        ws.Range("B" & ActiveCell.Row - 1).Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
        ws.Range("F" & ActiveCell.Row - 1).Activate
    End If

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Xabier, I tried your code and on my specific workbook, there is no change in the speed. However if I try it on a brand new workbook, it is very fast. So it must be something within this workbook. Perhaps some formatting, data validation, or conditional formatting dragging it down. The spreadsheet I am using it on has all 3 of those things. — Canaan Zeigler, Oct 22 '19 at 16:08
@CanaanZeigler, I've now updated my response to hopefully increase the performance of the process, hope it helps... :) — Xabier, Oct 22 '19 at 16:24
Thank you for your update, it did not make a difference in the performance. I posted an update above, I believe that our code is good, as all three work in a blank worksheet (fast), just not fast in the one I want it in. I will continue to try to see if I can find the source of the slow down. But I can live with it for now. Thanks for your help — Canaan Zeigler, Oct 22 '19 at 18:34

Cut and Paste Rows, Why So Slow, Trying To Speed Up Performance

1 Answers1