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
 
I'm sorry if i catched something,

If you open workbooks firstly, calculation speed up.

I use my scripts this;

Code:
    Workbooks.Open Filename:=".......xlsx"
    Workbooks("........xlsx").Sheets("...........").Activate
ActiveSheet.Calculate
    Workbooks("..........xlsx").Close

I think, your code should like this (If calculations over simpat);

Code:
'firstly
'select to worksheet 2015

Workbooks.Open Filename:="c:\......\PatientMerge.xls"
Workbooks(".......xls").Sheets("simpat").Activate

'second reactivate main workbook for calculations.

Workbooks("c:\......\PatientMerge.xls").Sheets("2015").Activate
ActiveSheet.Calculate

'at the end of script
Workbooks("c:\......\PatientMerge.xls").Close
end sub

This open files for calculation and close after that.
 
Upvote 0

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
@ avatarsiz; I don't assume it's opened.

@ fluffyvampirekitten; is the workbook PatientMerge.xls already opened?
 
Upvote 0
sorry for mistake;

Code:
'firstly
'select to worksheet 2015

Workbooks.Open Filename:="c:\......\PatientMerge.xls"

'second reactivate main workbook for calculations and calculate it.

Workbooks(".......xls").Sheets("simpat").Activate

your index script...........

'at the end of script
Workbooks("c:\......\PatientMerge.xls").Close
end sub
 
Upvote 0
If the workbook PatientMerge.xls is already opened, try this...

Code:
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Unsuccessful()
    [color=green]'Update Column S and T[/color]
    [color=green]'S = Active Ext ID , T = Inactive Ext ID[/color]
    
    [color=darkblue]Dim[/color] c [color=darkblue]As[/color] [color=darkblue]Variant[/color], j [color=darkblue]As[/color] [color=darkblue]Variant[/color], k [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] Result [color=darkblue]As[/color] [color=darkblue]Variant[/color], i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]With[/color] Workbooks("PatientMerge.xls").Sheets("2015")
        j = .UsedRange.Columns("J").Value
        k = .UsedRange.Columns("K").Value
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    Sheets("SimPat").Select
    c = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
    
    [color=darkblue]ReDim[/color] Result(1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](c, 1), 1 [color=darkblue]To[/color] 2)
    
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](c, 1)
        [color=darkblue]If[/color] IsNumeric(Application.Match(c(i, 1), j, 0)) [color=darkblue]Then[/color]
            Result(i, 1) = c(i, 1)
        [color=darkblue]ElseIf[/color] IsNumeric(Application.Match(c(i, 1), k, 0)) [color=darkblue]Then[/color]
            Result(i, 2) = c(i, 1)
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] i
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]With[/color] Range("S2:T2").Resize(UBound(Result, 1))
        .Value = Result
        .EntireColumn.AutoFit
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
If the workbook PatientMerge.xls is already opened, try this...

Code:
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Unsuccessful()
    [COLOR=green]'Update Column S and T[/COLOR]
    [COLOR=green]'S = Active Ext ID , T = Inactive Ext ID[/COLOR]
    
    [COLOR=darkblue]Dim[/COLOR] c [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], j [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], k [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] Result [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] Workbooks("PatientMerge.xls").Sheets("2015")
        j = .UsedRange.Columns("J").Value
        k = .UsedRange.Columns("K").Value
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    Sheets("SimPat").Select
    c = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
    
    [COLOR=darkblue]ReDim[/COLOR] Result(1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](c, 1), 1 [COLOR=darkblue]To[/COLOR] 2)
    
    [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](c, 1)
        [COLOR=darkblue]If[/COLOR] IsNumeric(Application.Match(c(i, 1), j, 0)) [COLOR=darkblue]Then[/COLOR]
            Result(i, 1) = c(i, 1)
        [COLOR=darkblue]ElseIf[/COLOR] IsNumeric(Application.Match(c(i, 1), k, 0)) [COLOR=darkblue]Then[/COLOR]
            Result(i, 2) = c(i, 1)
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]With[/COLOR] Range("S2:T2").Resize(UBound(Result, 1))
        .Value = Result
        .EntireColumn.AutoFit
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Is it better to ask the user to open the workbook manually?
 
Upvote 0
If the workbook PatientMerge.xls is already opened, try this...

Code:
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Unsuccessful()
    [COLOR=green]'Update Column S and T[/COLOR]
    [COLOR=green]'S = Active Ext ID , T = Inactive Ext ID[/COLOR]
    
    [COLOR=darkblue]Dim[/COLOR] c [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], j [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], k [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] Result [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] Workbooks("PatientMerge.xls").Sheets("2015")
        j = .UsedRange.Columns("J").Value
        k = .UsedRange.Columns("K").Value
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    Sheets("SimPat").Select
    c = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
    
    [COLOR=darkblue]ReDim[/COLOR] Result(1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](c, 1), 1 [COLOR=darkblue]To[/COLOR] 2)
    
    [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](c, 1)
        [COLOR=darkblue]If[/COLOR] IsNumeric(Application.Match(c(i, 1), j, 0)) [COLOR=darkblue]Then[/COLOR]
            Result(i, 1) = c(i, 1)
        [COLOR=darkblue]ElseIf[/COLOR] IsNumeric(Application.Match(c(i, 1), k, 0)) [COLOR=darkblue]Then[/COLOR]
            Result(i, 2) = c(i, 1)
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]With[/COLOR] Range("S2:T2").Resize(UBound(Result, 1))
        .Value = Result
        .EntireColumn.AutoFit
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]


May i ask what is the difference between this method and the index match method ?
Which way is more efficient ?
Which way will prevent lesser error ?
New Changes : Start at row 3 - C3
 
Upvote 0
If the workbook PatientMerge.xls is already opened, try this...

Code:
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Unsuccessful()
    [COLOR=green]'Update Column S and T[/COLOR]
    [COLOR=green]'S = Active Ext ID , T = Inactive Ext ID[/COLOR]
    
    [COLOR=darkblue]Dim[/COLOR] c [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], j [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], k [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] Result [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] Workbooks("PatientMerge.xls").Sheets("2015")
        j = .UsedRange.Columns("J").Value
        k = .UsedRange.Columns("K").Value
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    Sheets("SimPat").Select
    c = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
    
[COLOR=#FF0000]    [B]ReDim Result(1 To UBound(c, 1), 1 To 2)
Could you explain to me this line ? 
(C, 1 ) - 
1 To 2 - [/B][/COLOR]
    
    [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](c, 1)
        [COLOR=darkblue]If[/COLOR] IsNumeric(Application.Match(c(i, 1), j, 0)) [COLOR=darkblue]Then[/COLOR]
            [B][COLOR=#FF0000]Result(i, 1) = c(i, 1)[/COLOR][/B]
        [COLOR=darkblue]ElseIf[/COLOR] IsNumeric(Application.Match(c(i, 1), k, 0)) [COLOR=darkblue]Then[/COLOR]
            Result(i, 2) = c(i, 1)
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]With[/COLOR] Range("S2:T2").Resize(UBound(Result, 1))
        .Value = Result
        .EntireColumn.AutoFit
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Could you kindly explain in simple english , those words in red and bold?
Sorry, I'm trying to understand the logic behind it :(
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,189
Members
452,616
Latest member
intern444

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