Copy and paste on loop for a set range

[chris priyesh]

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

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

 

[Joe4]

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:

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!

 

[alansidman]

Try this:

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]

Try:

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]

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]

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.

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]

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]

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]

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]

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

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