Copy and paste on loop for a set range

chris priyesh

New Member
Joined
May 10, 2014
Messages
7
Dear Experts, need your help.

I am working on a huge excel file with over 50k rows. I have a formula in Cell L2. If i use filldown, the excel is taking too long to process. My idea is to copy the formula in L2, paste it in the remaining cells of column L (i.e., from L3 to the end), then copy and paste the cells from L3 to the end as values.

Considering the speed, i wanted to do it on a loop for every 500 Cells. The steps would be as follows:

Step 1: Set Range based on Column A
Step 2: Copy formula in L2
Step 3: Paste in L3 : L503
Step 4: Copy L3:L503 and paste special -values in L3:L503
Step 5: Copy Formula in L2
Step 6: Paste in L504 : L1004 ...
Continue till range is filled.

I came up with the following Code. But the code is not dynamic and is not working. can you guys help me. Thanks in advance

Code:
Sub Fill()
Dim i As Long
For i = 1 To Range("a1", Range("a" & Rows.Count).End(xlUp)).Value
Range(B2).Select
Selection.Copy
 Range("B2:B" & i).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

Next i


End Sub

 

Some videos you may like

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,974
Office Version
  1. 365
Platform
  1. Windows
You want to avoid using any sort of SELECT or ACTIVATE commands in your code, whenever possible. They will slow your code down.

You can do what you want pretty quickly and easily with only a little code, and no selects, like this:
Code:
Sub MyFill()

    Dim lRow As Long
    
'   Find last row with data in column A
    lRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Range("L2").Copy Range("L3:L" & lRow)
    Range("L2:L" & lRow).Value = Range("L2:L" & lRow).Value
    
End Sub
Also: Don't use reserved words (names of existing functions, properties, and methods) like "Fill" as the name of your procedures or variables! That can cause ambiguity, causes errors and unexpected results!
 
Last edited:

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,069
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Try this:

Code:
Option Explicit


Sub CopyL2()
    Dim lr As Long
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    lr = Range("A" & Rows.Count).End(xlUp).Row
    Range("L2").Copy
    Range("L3:L" & lr).PasteSpecial (xlPasteFormulas)
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,160
Try:
Code:
Sub CopyValue()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("L2").Copy Range("L3:L" & LastRow)
    Range("L3:L" & LastRow).Value = Range("L3:L" & LastRow).Value
    Application.ScreenUpdating = True
End Sub
 

chris priyesh

New Member
Joined
May 10, 2014
Messages
7

ADVERTISEMENT

Thanks for the quick revert Mr Joe, Mr Alan and Mumps.
However this does not serve the purpose. As mentioned, the number of Rows involved are high. if i paste the data in all the cells in a single go, it is taking too long to process. Thats the reason I wanted to do it on a loop.

Can you help me with the same.

Thanks
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,160
I tried the macro on a dummy sheet copy/pasting the formula down to row 50000 and it took less than one second. See if this version helps.
Code:
Sub CopyValue()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("L2").Copy Range("L3:L" & LastRow)
    Range("L3:L" & LastRow).Value = Range("L3:L" & LastRow).Value
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,974
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Do you have any other VBA code in this workbook?
Perhaps some event procedure code that might be interfering with this (and slowing things down)?
 

chris priyesh

New Member
Joined
May 10, 2014
Messages
7
Dear Mumps and Joe

the formula in cell L2 is as follows
L2=IF(C3=C2,IF(AND(F3<F2,F3<G3,D3>=Summary!$B$3),MIN(F3+MIN(Summary!$B$6,F3*Summary!$B$5),H2),H2),G3+Summary!$B$6)

May be it is taking time for me to process as the formula is a little complex. Hence wanted to try it through a loop where i am assuming things would be a little faster as only 500 cells would be processed at a time instead of 50k at a time.

Any other idea that would help me process the file at a faster pace?

Thanks
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,069
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
To speed up processing in VBA, it is important to shut off the screen update and also to set the recalculation to manual as shown in my code and also in Mumps second code. Make sure that your code includes these steps.
 

chris priyesh

New Member
Joined
May 10, 2014
Messages
7
To speed up processing in VBA, it is important to shut off the screen update and also to set the recalculation to manual as shown in my code and also in Mumps second code. Make sure that your code includes these steps.

Tried the same, but the system is crashing. Given below is the code im using. Kindly let me know if there is any way that i can make this work

Code:
Sub Master()'Settings Open
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
'Fill CE
    Sheets("CE").Select
    Call TestFill
'Fill PE
    Sheets("PE").Select
    Call TestFill
'Settings close
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True


End Sub


Sub TestFill()


'Set Range
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'SP
    Range("G2").Copy Range("G3:G" & LastRow)
    Calculate
    Range("G3:G" & LastRow).Value = Range("G3:G" & LastRow).Value
'TSp
    Range("H3").Copy Range("H4:H" & LastRow)
    Calculate
    Range("H4:H" & LastRow).Value = Range("H4:H" & LastRow).Value
'Bp
    Range("I3").Copy Range("I4:I" & LastRow)
    Calculate
    Range("I4:I" & LastRow).Value = Range("I4:I" & LastRow).Value
'ABP
    Range("J2").Copy Range("J3:J" & LastRow)
    Calculate
    Range("J3:J" & LastRow).Value = Range("J3:J" & LastRow).Value
'FBP
    Range("K2").Copy Range("K3:K" & LastRow)
    Calculate
    Range("K3:K" & LastRow).Value = Range("K3:K" & LastRow).Value


End Sub


P.s: Data is in 3 sheets 'CE', 'PE', 'SUMMARY'
The formulas of each field mentioned above are as follows:
G2 =C2&" "&TEXT(D2,"DD-MM-YYYY")&" "&TEXT(E2,"HH:MM:SS")
H3 =VLOOKUP(F2,Summary!D:E,2,0)
I3=IF(F3=F2,IF(AND(H3<H2,H3<I3,E3>=Summary!$B$3),MIN(H3+MIN(Summary!$B$6,H3*Summary!$B$5),J2),J2),H3+Summary!$B$6)
J2=IF(AND(F3=F2,H3>J3,E3>Summary!$B$3,SUMIF($D$2:K2,D3,$K$2:K2)<=0),J3,0)
K=IF(AND(SUMIF($D$2:K2,D2,$K$2:K2)<=0,E2=Summary!$B$4),H2,0)


All help is greatly appreciated.

Thanks in advance
 

Watch MrExcel Video

Forum statistics

Threads
1,123,258
Messages
5,600,568
Members
414,389
Latest member
MarkElla

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top