How to speed up this index match function

I have these lines of codes and this macro runs really slow until it stop responding at some point of time
Any suggestion to speed up this macro ?
Both files are dynamic.


Any idea?[/COLOR]

Private Sub Unsuccessful()
'Update Column S and T
'S = Active Ext ID , T = Inactive Ext ID

Dim MaxRowNum As Long

Sheets("SimPat").Select

'Set up an Error handler
On Error GoTo errorFound
Err.Clear
On Error GoTo 0

    
'Vlookup/IndexMatch Active Ext ID
Range("S2").FormulaR1C1 = _
      "=INDEX('[PatientMerge.xls]2015'!C10,MATCH(C[-16],'[PatientMerge.xls]2015'!C10,0))"

'Vlookup/IndexMatch Inactive Ext ID
Range("T2").FormulaR1C1 = _
      "=INDEX('[PatientMerge.xls]2015'!C11,MATCH(C[-17],'[PatientMerge.xls]2015'!C11,0))"
    
    
    'Locate last filled row in column S (this instead of the loop)
    MaxRowNum = Range("S" & Rows.Count).End(xlUp).Row
 
    
    'Autofill the rest of the rows
    Range("S2:T2").Select
    Selection.AutoFill Destination:=Range("S2:T2" & MaxRowNum), Type:=xlFillDefault
    'Column S and T Autofit
    Columns("S:T").Select
    Columns("S:T").EntireColumn.AutoFit
            
    'Copy and Paste data as value
    Sheets("SimPat").Select 'Activate/Open Simpat again
    Range("S2:T2" & MaxRowNum).Select
    Selection.Copy
    Worksheets("Simpat").Range("U2:V2" & MaxRowNum).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
       
    Columns("S:S").Select
    Selection.Delete Shift:=xlToLeft
    Columns("T:T").Select
    Selection.Delete Shift:=xlToLeft
       
    Application.CutCopyMode = False
    
With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
End With


'Close the error Handler
Exit Sub
errorFound:
If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Error#: & Err.Number"
Err.Clear

End Sub

Really need it urgently

Cross Ref: http://www.mrexcel.com/forum/excel-q...ml#post4226694



Just updated my code cos the copy/paste and autofill wasnt working properly.
However it is still running slow

Private Sub Unsuccessful3()

'Update Column S and T
'S = Active Ext ID , T = Inactive Ext ID
Dim MaxRowNum As Long
With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
End With
Sheets("SimPat").Select
'Set up an Error handler
On Error GoTo errorFound
Err.Clear
On Error GoTo 0
    'Locate last filled row in column S (this instead of the loop)
    MaxRowNum = Range("C" & Rows.Count).End(xlUp).Row
    
'Vlookup/IndexMatch Active Ext ID
Range("S2:S" & MaxRowNum).Formula = "=INDEX('[PatientMerge.xls]2015'!$J:$J,MATCH(C:C,'[PatientMerge.xls]2015'!$J:$J,0))"
'Vlookup/IndexMatch Inactive Ext ID
Range("T2:T" & MaxRowNum).Formula = "=INDEX('[PatientMerge.xls]2015'!$K:$K,MATCH(C:C,'[PatientMerge.xls]2015'!$K:$K,0))"
    Columns("S:T").EntireColumn.AutoFit
            
    'Copy and Paste data as value
    Sheets("SimPat").Range("S2:T" & MaxRowNum).Copy
    Sheets("SimPat").Range("S2:T" & MaxRowNum).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
End With
'Close the error Handler
Exit Sub
errorFound:
If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Error#: & Err.Number"
Err.Clear

End Sub

Try this...

Private Sub Unsuccessful()
Dim MaxRowNum As Long

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

With Sheets("SimPat")
    .Range("S2").FormulaR1C1 = _
          "=INDEX('[PatientMerge.xls]2015'!C10,MATCH(C[-16],'[PatientMerge.xls]2015'!C10,0))"
    .Range("T2").FormulaR1C1 = _
          "=INDEX('[PatientMerge.xls]2015'!C11,MATCH(C[-17],'[PatientMerge.xls]2015'!C11,0))"
    MaxRowNum = .Range("S" & Rows.Count).End(xlUp).Row
    .Range("S2:T2").AutoFill Destination:=.Range("S2:T2" & MaxRowNum), Type:=xlFillDefault
    .Columns("S:T").EntireColumn.AutoFit
    .Range("S2:T2" & MaxRowNum).Copy
    .Range("U2:V2" & MaxRowNum).PasteSpecial Paste:=xlPasteValues
    .Columns("S:S").Delete Shift:=xlToLeft
    .Columns("T:T").Delete Shift:=xlToLeft
    Application.CutCopyMode = False
End With

With Application
    .Calculation = xlCalculationAutomatic
    DoEvents
    .ScreenUpdating = True
End With

End Sub

Hi,

You have to turn off some Excel functionality so your code runs faster

Private Sub Unsuccessful()
'Update Column S and T
'S = Active Ext ID , T = Inactive Ext ID

Dim MaxRowNum As Long

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

‘>>your code goes here<<

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationautomatic
Application.EnableEvents = True

End sub

The first thing to learn when writing macros is that the Select command should be avoided because it slows it down a lot.

This is slow code

 Columns("T:T").Select
    Selection.Delete Shift:=xlToLeft

This is much faster

 Columns("T:T").Delete Shift:=xlToLeft