How to speed up index match function

fluffyvampirekitten

Board Regular
Joined
Jul 1, 2015
Messages
72
I have this line of codes
however , my excel will lag and most of the time it will stop responding .
Why? :(
Cross Ref: How to speed up this index match function

Any suggestion ?

Code:
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
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Put this at the start of the code
Code:
With Application
        .ScreenUpdating = false
        .Calculation = xlCalculationManual
End With

Then try and remove as many of the Select.Selection lines as they are unnecessary and will slow down you code !
 
Upvote 0
Don't have Excel at the moment, but I think this will be quicker
Code:
Private Sub Unsuccessful()
'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("S" & 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("U2:V" & MaxRowNum).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Columns("S:S").Delete
    Columns("T:T").Delete
    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
 
Upvote 0
Don't have Excel at the moment, but I think this will be quicker
Code:
Private Sub Unsuccessful()
'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("S" & 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("U2:V" & MaxRowNum).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Columns("S:S").Delete
    Columns("T:T").Delete
    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

It only fills up the first 2 rows :( why is that so ?
And it seems that the copy/paste isnt working , cos i still can see the formula T^T :confused:
Any ideas what went wrong ?
 
Upvote 0
It only fills up the first 2 rows why is that so
That's because Maxrownum is probably only 2 based on col "S". Try using a different column as the reference.

Can't see why the pastespecial won't work....it's fine for me !!
I'd also consider changing your INDEX/MATCH formula to cover a smaller range than the entire column !!
Maybe something like

Code:
=INDEX('[PatientMerge.xls]2015'!$K1:$K100,MATCH(C1:C100,'[PatientMerge.xls]2015'!$K1:$K100,0))

That will also improve the speed
 
Upvote 0
I just encounter another problem , it seems that the formula didnt fill all the rows
and copy paste codes isnt seems working
frown.gif


Any idea?
 
Upvote 0
Did you see my previous post on the MaxRowNum variable ???
 
Upvote 0
That's because Maxrownum is probably only 2 based on col "S". Try using a different column as the reference.

Can't see why the pastespecial won't work....it's fine for me !!
I'd also consider changing your INDEX/MATCH formula to cover a smaller range than the entire column !!
Maybe something like

Code:
=INDEX('[PatientMerge.xls]2015'!$K1:$K100,MATCH(C1:C100,'[PatientMerge.xls]2015'!$K1:$K100,0))

That will also improve the speed

I changed the max row num ^^
I wish i can to shorten the range however , i need to cover this amount of range.
It still runs slow however , i think its faster than before .
Okay , the copy paste is working but .... only this formula is showing
Code:
Range("T2:T" & MaxRowNum).Formula = "=INDEX('[PatientMerge.xls]2015'!$K:$K,MATCH(C:C,'[PatientMerge.xls]2015'!$K:$K,0))"
After running the code , this is what i see for my column S and T
1.) Column S - It shows the formula (Range("T2:T" & MaxRowNum).Formula)
2.) Column T - It shows the values only (Range("T2:T" & MaxRowNum).Formula)
I dont see this line.I didnt execute this line ?
Code:
'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))"

Code:
[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("U2:V" & MaxRowNum).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Columns("S:S").Delete
    Columns("T:T").Delete
    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
 
Last edited:
Upvote 0
I can't imagine your formula would need to refer to over 1 million rows !!!
I wish i can to shorten the range however , i need to cover this amount of range.
AND rather than put the formulae in cols S and T.....why not put them in U and V where they are ultimately going anyway. Then simply make them values where they are !!
 
Upvote 0
I can't imagine your formula would need to refer to over 1 million rows !!!

AND rather than put the formulae in cols S and T.....why not put them in U and V where they are ultimately going anyway. Then simply make them values where they are !!

Is it possible to put them in cols S and T?
I tried copy/paste in Col S and T last time , i can only see the #N/A.
My Patient File have thousands of records and my Simpat have a few hundreds and it will be updated weekly :(
 
Upvote 0

Forum statistics

Threads
1,215,005
Messages
6,122,661
Members
449,091
Latest member
peppernaut

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
Back
Top