Speeding up my code

[RobbertH]

Hi guys,

I have a file in which, based on two criteria (=unique IDs), I like to paste comments that come from anonther worksheet in my file. The piece of code below does the trick but i **** slow. How can I tweak this in order to make it quicker?

Hope you can help!

Sub Paste comments()
Application.screenUpdating = False
For Each Cell In Range(Cells(2, 2), Cells(2, 2).End(xlDown))
    If Cell.Offset(0, 15) = 1 Then
        Cell.Offset(0, 14).FormulaR1C1 = "=IFERROR(INDEX('Standaard Verklaringen'!R1C2:R250C4,SUMPRODUCT(Match(" & Cell & "&" & Cell.Offset(0, 5).Value & ",'Standaard Verklaringen'!R1C2:R250C2&'Standaard Verklaringen'!R1C3:R250C3,0)),3),"""")"
        Cell.Offset(0, 14).Value = Cell.Offset(0, 14).Value
    End If
Next Cell
Application.ScreenUpdating = True
End Sub

 

[Derek Brown]

It seems to me that you are recalculating all open workbooks when you update each cell using "Cell.Offset(0, 14).FormulaR1C1" before then converting the result to 'values'.
I would try setting calculation to manual using 'Application.Calculation' and performing the loop twice. The first time to enter the formulas, then recalculate the worksheet before the second loop to convert the formulas to values. At the end reset the calculation mode back to what it was.

 

[John Davis]

Hi guys,

I have a file in which, based on two criteria (=unique IDs), I like to paste comments that come from anonther worksheet in my file. The piece of code below does the trick but i **** slow. How can I tweak this in order to make it quicker?

Hope you can help!

Sub Paste comments()
Application.screenUpdating = False
For Each Cell In Range(Cells(2, 2), Cells(2, 2).End(xlDown))
    If Cell.Offset(0, 15) = 1 Then
        Cell.Offset(0, 14).FormulaR1C1 = "=IFERROR(INDEX('Standaard Verklaringen'!R1C2:R250C4,SUMPRODUCT(Match(" & Cell & "&" & Cell.Offset(0, 5).Value & ",'Standaard Verklaringen'!R1C2:R250C2&'Standaard Verklaringen'!R1C3:R250C3,0)),3),"""")"
        Cell.Offset(0, 14).Value = Cell.Offset(0, 14).Value
    End If
Next Cell
Application.ScreenUpdating = True
End Sub

This may be more than a tweak, but maybe it can give you some ideas

Sub RobbertH()
Dim lr As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(3).Row
With Range("Q1:Q" & lr)

    .AutoFilter Field:=1, Criteria1:=1
    .SpecialCells(xlCellTypeVisible).Offset(0, -1).FormulaR1C1 = "=IFERROR(INDEX('Standaard Verklaringen'!R1C2:R250C4,SUMPRODUCT(Match("" & Cell & ""&"" & Cell.Offset(0, 5).Value & "",'Standaard Verklaringen'!R1C2:R250C2&'Standaard Verklaringen'!R1C3:R250C3,0)),3),"""")"
    .SpecialCells(xlCellTypeVisible).Offset(0, -1).Value = .SpecialCells(xlCellTypeVisible).Offset(0, -1).Value
    .AutoFilter
    .AutoFilter
    
End With
Range("P1").ClearContents
Application.ScreenUpdating = True
End Sub