Fastest Method to Copy Large Number of Values in Excel VBA - vba

Question

Quite simply, I am wondering what the fastest method of copying cell values from one sheet to another is.
Generally, I'll loop through the cells by column and/or row and use a line such as:
Worksheets("Sheet1").Cells(i,j).Value = Worksheets("Sheet1").Cells(y,z).Value
In other cases where my ranges are not consecutive rows/columns (e.g. I want to avoid overwriting cells that already contain data) I'll either have a conditional inside the loop, or I'll fill an array(s) with row & column numbers that I want to cycle through, and then cycle through the array elements. For example:
Worksheets("Sheet1").Cells(row1(i),col1(j)).Value = Worksheets("Sheet2").Cells(row2(y),col2(z)).Value
Would it be faster to define ranges using the cells I want to copy and the destination cells, then do a Range.Copy and Range.Paste operation? Is it possible to define a range using an array without having to loop through it anyway? Or will it be faster anyway to loop through an array to define a range and then copy-pasting the range instead of equating the cell values by looping?
I feel like it might not be possible to copy and paste ranges like this at all (i.e. they would need to be cells continuous through a rectangular array and pasted into a rectangular array of the same size). That being said, I would think that it's possible to equate the elements of two ranges without looping through each cell and equating the values.

Answer 1

For a rectangular block this:
Sub qwerty()
Dim r1 As Range, r2 As Range
Set r1 = Sheets("Sheet1").Range("A1:Z1000")
Set r2 = Sheets("Sheet2").Range("A1")
r1.Copy r2
End Sub
is pretty quick.
For a non-contiguous range on the activesheet, I would use a loop:
Sub qwerty2()
Dim r1 As Range, r2 As Range
For Each r1 In Selection
r1.Copy Sheets("Sheet2").Range(r1.Address)
Next r1
End Sub
EDIT#1:
The range-to-range method does not even require an intermediate array:
Sub ytrewq()
Dim r1 As Range, r2 As Range
Set r1 = Sheets("Sheet1").Range("A1:Z1000")
Set r2 = Sheets("Sheet2").Range("A1:Z1000")
r2 = r1
End Sub
this is really the same as:
ary=r1.Value
r2.value=ary
except the ary is implicit.

Answer 2

i tried 4 methods, and the NOT obvious (to me) came out:
Option Explicit
Sub testCopy_speed()
Dim R1 As Range, r2 As Range
Set R1 = ThisWorkbook.Sheets(1).Range("A1:Z1000")
Set r2 = ThisWorkbook.Sheets(2).Range("A1:Z1000")
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim t As Single
Dim i&, data(), Rg As Range
ReDim data(R1.Rows.Count, R1.Columns.Count)
For Each Rg In R1.Cells: Rg = Rnd()*100: Next Rg
R1.ClearContents
R1.ClearFormats
r2.ClearContents
r2.ClearFormats
'For Each Rg In R1.Cells: 'if you do this too often , you'll get an error
' With Rg
' .Value2 = Rnd() * 100
' .Interior.Color = Rnd() * 65535
' '.Font.Color = Rnd() * 65535
' End With
'Next Rg
t = Timer
For i = 1 To 100
'r2.Value2 = R1.Value2 '1,71 sec
'R1.Copy r2 '0.74 sec <<<< Winer , but see NOTE.
'data = R1.Value2: r2.Value2 = data '1.78 sec
'For Each Rg In R1.Cells: r2.Cells(Rg.Row, Rg.Column).Value2 = Rg.Value2: Next Rg '54 seconds !!
Next i
Erase data
Set R1 = Nothing
Set r2 = Nothing
Set Rg = Nothing
Debug.Print Timer - t
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Note : i wasn't happy with these results so i tested some more, and if R1 contains many different formating , the R1.copy R2 method will take 10 seconds. So in this case R2=R1would be better by far (6 times faster).

Answer 3

I found this thread looking to speed up transfer of 72 cells from one sheet to another (a data storage sheet to a data entry sheet).
My code looked like this:
t(7)=timer*1000
Dim datasht As Worksheet
Set datasht = WB2.Worksheets("Equipment-Data")
With WB2.Worksheets("Equipment")
.Range("D2").Value = datasht.Cells(datarow, 1)
.Range("D3").Value = datasht.Cells(datarow, 2)
.Range("I7").Value = datasht.Cells(datarow, 3)
...
t(8)=timer*1000
...
.Range("G51").Value = datasht.Cells(datarow,72)
End With
t(9)=timer*1000
Code typed by hand, please forgive any typos.
Getting from t(7) to t(9) took around 600ms. As an aside, I switched from using Application.WorksheetFunction.Vlookup 72 times to determining the appropriate row in the data table with a single datarow=.Cells.Find(...) and it made no perceivable impact in execution time.
I added a timer in the middle and confirmed that each half was taking roughly 300ms which made sense but wanted to make sure there wasn't a particular cell causing issues.
Since most of the time only 1 or a small handful of cells have changed I added a check to see if the data is different before writing and the Sub now runs in about 4ms.
If .Range("D2").Formula <> datasht.Cells(datarow, 1).Formula Then .Range("D2").Value = datasht.Cells(datarow, 1)

Answer 4

Never try to loop over big data set with many rows. Try to copy ranges by columns as much as possible.
Dim lRow As Long
lRow = Sheets("Source").Range("A100000").End(xlUp).Row
Sheets("Target").Range("A1:D" & lRow).Value =
Sheets("Source").Range("G1:J" & lRow).Value

Answer 5

Sub CopyPaste(rPaste As Range, rCopy As Range, Optional val As Boolean = True)
Dim p As Long
Dim r As Long
Dim c As Long
Dim aCalculation As XlCalculation
aCalculation = XlCalc()
On Error GoTo Finally
Try:
If rPaste.Count = 1 Then
r = rPaste.Areas(1).Row - rCopy.Areas(1).Row
c = rPaste.Areas(1).Column - rCopy.Areas(1).Column
For p = 1 To rCopy.Areas.Count
With rCopy.Areas(p)
Set rPaste = Union(rPaste, Cells(.Row, .Column).Offset(r, c).Resize(.Rows.Count, .Columns.Count))
End With
Next 'p
End If
For p = 1 To rPaste.Areas.Count
With Cells(rCopy.Areas(p).Row, rCopy.Areas(p).Column).Resize(Application.min(rCopy.Areas(p).Rows.Count, rPaste.Areas(p).Rows.Count), _
Application.min(rCopy.Areas(p).Columns.Count, rPaste.Areas(p).Columns.Count))
If val Then
If 1 Then 'faster
rPaste.Areas(p) = .Value
Else
.Copy
Cells(rPaste.Areas(p).Row, rPaste.Areas(p).Column).PasteSpecial paste:=xlPasteValues
End If
Else
.Copy Destination:= _
Cells(rPaste.Areas(p).Row, rPaste.Areas(p).Column)
End If 'val
End With
Next 'p
Finally:
XlCalc aCalculation
End Sub
Function XlCalc(Optional aCalculation As Long = 0) As XlCalculation
Dim bCutCopyMode As Boolean
Dim bCleared As Boolean
bCutCopyMode = Application.CutCopyMode
XlCalc = Application.Calculation
Application.EnableEvents = aCalculation <> 0
Application.ScreenUpdating = aCalculation <> 0
'assignment to Application.Calculation clears the clipboard
If aCalculation = 0 Then
bCleared = XlCalc <> xlCalculationManual
If bCleared Then Application.Calculation = xlCalculationManual
Else
If aCalculation = xlCalculationAutomatic Then Application.Calculate
bCleared = XlCalc <> aCalculation
If bCleared Then Application.Calculation = aCalculation
End If
If Not bCleared Then Exit Function
If Not bCutCopyMode Then Exit Function
If Selection Is Nothing Then Exit Function
Selection.Copy 'restore clipboard
End Function

Answer 6

Disabling ScreenUpdating adds 8 ms on my machine
Disabling Calculation adds 6
There is no appreciable difference (in microseconds!) between
.Range(cstrColPreviousPrice & clngFirstRow & ":" & cstrColPreviousPrice & glngLastRow).Value2 = .Range(cstrColPrice & clngFirstRow & ":" & cstrColPrice & glngLastRow).Value2
And
.Range(cstrColPreviousPrice & clngFirstRow & ":" & cstrColPreviousPrice & glngLastRow).Value2 = Application.Transpose(gavarPrice())