CODEWITHSUNDEEP
vbaexcelexcel-2010
Luiz Roberto W Silva
Luiz Roberto W Silva

Reputation: 3

Copy Destination Method Not Working for Large Amount of Data/Formula

Below extracted code is working perfectly if iRow is up to 40,000 (note that it leads to a total of 3,720,000 formulas...). I now need to do the same for iRow above 100,000 and it is exponentially BAD, if it finishes... I left PC turned on for more than one day and it didn't.

Dim iRow    As LongPtr

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

WSD.Range("K2:CZ2").Copy Destination:=WSD.Range("K3:CZ" & iRow)
Application.Calculation = xlCalculationAutomatic
Application.Calculation = xlCalculationManual
WSD.Range("K3:CZ" & iRow).Value = WSD.Range("K3:CZ" & iRow).Value

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

Any light on this issue will be very much appreciated.

Configuration: Excel 2010 x64 VBA7 WIN64

Upvotes: 0

Views: 937

Answers (1)

David Zemens
David Zemens

Reputation: 53623

This worked for me and took less than 30 seconds:

Sub CopyExample()
Dim iRow As Long
Dim calcState As Long

iRow = 100000
calcState = Application.Calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.Range("A1:CZ1").Copy Destination:=ActiveSheet.Range("A2:CZ" & iRow)
Application.Calculation = calcState
Application.ScreenUpdating = True
End Sub

You may want to do something other than .Copy though, if that is still giving you trouble.

EDIT #1 Attempt to use AutoFill method instead of Copy method. For 50,000 rows this took under 2 minutes. My dummy data has volatile Rand() function, and another function that is based on this function, across all columns from A1:CZ1.

Option Explicit

Sub CopyExample2()
Dim iRow As Long
Dim calcState As Long
Dim sourceRange As Range
Dim pasteRange As Range
Dim t As Long

t = Timer
iRow = 100000
calcState = Application.Calculation

'Turn off screenupdating, calculation, etc.'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set sourceRange = ActiveSheet.Range("A1:CZ1")
Set pasteRange = ActiveSheet.Range("A1:CZ" & iRow)
    With sourceRange
        .AutoFill pasteRange
    End With

'Turn on calculation, screenupdating, etc.'
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Debug.Print Timer - t

End Sub

Upvotes: 2

Related Questions