Copy down formula in increments of 1000 at a time

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Copy down formula in increments of 1000 at a time

Post by gailb »

I have a spreadsheet of about 140k rows. When filling in a formula it takes an extremely long time for the processor to cover the 140k rows with the new formula. I thought maybe only doing 1000's rows at a time could have with the processing time plus making the previous 1000 values before filling the formula down any farther. With this macro I've tested with 10 rows at a time and it seems to work fine.


Two questions.
1) How can I get the macro to stop at the last row without doing another 10 rows even though maybe there are only 3 rows left at the bottom?
2) Should I put a delay between each loop and what would be the best way to do this?


Code: Select all

Sub Demo()
    Dim lRow As Long: lRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim i As Long
    For i = 2 To lRow Step 10
        With Range("B" & i).Resize(10)
            .FormulaR1C1 = "=XLOOKUP(RC[-1],R2C8:R20C8,R2C9:R20C9)"
            .Copy
            .PasteSpecial Paste:=xlPasteValues
        End With
    Next i
End Sub

User avatar
HansV
Administrator
Posts: 78488
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy down formula in increments of 1000 at a time

Post by HansV »

Try this. With 140000 rows, it takes 1.2 seconds on my PC.

Code: Select all

Sub Demo()
    Dim lRow As Long
    Application.ScreenUpdating = True
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    With Range("B2:B" & lRow)
        .Formula2R1C1 = "=XLOOKUP(RC[-1],R2C8:R20C8,R2C9:R20C9)"
        .Value = .Value
    End With
    Application.ScreenUpdating = False
End Sub
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Copy down formula in increments of 1000 at a time

Post by gailb »

It took 294 seconds on my work laptop. I suspect, a difference is my xlookup. On the real data, the lookup cover over 20k rows.

Code: Select all

Sub Demo()
    Dim lRow As Long: lRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim sngStartTimer As Single: sngStartTimer = Timer
    TurnEverythingOff
    On Error GoTo Skip
    With Range("K2:K" & lRow)
        .Formula2R1C1 = "=XLOOKUP(1,('DHA HQ OSC'!R2C3:R20581C3=RC[-10])*('DHA HQ OSC'!R2C7:R20581C7=RC[-1]),'DHA HQ OSC'!R2C6:R20581C6)"
        .Value = .Value
    End With
Skip:
    MsgBox Int(Timer - sngStartTimer) & " Secs"
    TurnEverythingOn
End Sub

Code: Select all

Sub TurnEverythingOff()
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .DisplayAlerts = False
    .ScreenUpdating = False
End With
End Sub

Code: Select all

Sub TurnEverythingOn()
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

User avatar
HansV
Administrator
Posts: 78488
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy down formula in increments of 1000 at a time

Post by HansV »

In that case, I don't think breaking the code up into chunks would make much difference...
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Copy down formula in increments of 1000 at a time

Post by gailb »

Ok, thank you for your time.