0

I have this small code which cuts and pastes a cell to another cell if the cell has an empty adjacent cell. But every time I run this code, it usually takes more than a minute to finish the entire column. Here's my small code.

Sub MoveCell()
Dim A As Range

  For Each A In Range("B10:B1000")
    If A <> "" Then
      If A.Offset(0,2) = "" Then
        A.Cut A.Offset(0,4)
      End If
    End If
  Next

End Sub

Is there a way around this code?

2 Answers2

4

Some Suggestions for optimizing:

Do you really need to go all the way to row 1000? Right now, you're processing 990 rows every time you call this code. It is best only go as high as you need to for the application.

Cut and Paste is rather expensive relative to simply setting the cells to a value. Use the following instead:

If A.Offset(0,2) = "" Then  
    A.Offset(0,4) = A

If you STILL need more efficiency, you can load the data into a Variant, process it, and return it to the sheet:

Dim dataVar as Variant
Dim i as Integer

dataVar = Range("B10:F1000")
For i = Lbound(dataVar, 1) to Ubound(dataVar, 1)
' Omitted code for your processing
Next i

Range("B10:F1000") = dataVar
CodeJockey
  • 1,922
  • 1
  • 15
  • 20
3

Setting Application.ScreenUpdating = False before your loop and Application.ScreenUpdating = True after the loop should stop the screen flashing and may improve the time slightly.

aphoria
  • 19,796
  • 7
  • 64
  • 73
  • 2
    Disabling screen updating is usually the single best way to improve processing time. You should consider using some error handling (`On Error GoTo` statements) and include the re-enabling statement in there so the screen updates don't stay off if your macro crashes. – techturtle May 16 '14 at 18:23