Increasing the speed of Index & Match in VBA

dreen

Board Regular
Joined
Nov 20, 2019
Messages
52
My code works and executes exactly what I need it to do, but I would like to improve it's processing time as updating each individual cell is significantly slowing down my macro.
Currently, I am using VBA to do an Index & Match formula with another workbook where it retrieves information (parameters) from. I believe the slow processing time is because I'm updating the values in each individual cell using Index and Match by using a Range. I am trying to mass load Variant arrays instead as an alternate solution but I am struggling with incorporating it into my code. If there is also another method of increasing the processing time please let me know, variant arrays was just a method I was trying.
Here is my current code using Index & Match with Range:


VBA Code:
'This macro uses an Index and Match application to fill in the "Changes Pending Approval" parameters in the "Operator" worksheet

Private Sub Worksheet_Calculate()                                                                   'Occurs after the worksheet is recalculated for the Worksheet object (any changes in the intersect cell)

Application.ScreenUpdating = False                                                                  'This speeds up the macro by hiding what the macro is doing

If Not Intersect(Range("H4"), Range("H4")) Is Nothing Then                                          'Checking if the "Key" (part or process) has been changed

Dim yChanges As Worksheet, OperatorWs As Worksheet                                                  'Declaring worksheets as variables
Dim yChangesLastRow As Long, Parameters As Long, x As Long, z As Long                               'Declaring variables to count last rows and "x" & "z" as integers (long variables)

Set y = Workbooks.Open(Filename:="\Databases\Database_IRR 200-2S.xlsm", Password:="Swarf")          'Sets the Workbook variable as the database filepath
Set yChanges = y.Sheets("Changes")                                                                  'Sets the Worksheet variable as the "Changes" sheet in the database's workbook
Set OperatorWs = ThisWorkbook.Worksheets("Operator")                                                'Sets the Worksheet variable as the "Operator" sheet in this workbook
OperatorWs.Unprotect "123"                                                                          'Unprotects the "Operator" sheet

Parameters = yChanges.Range("F1:CL1").Columns.Count                                                 'Counts the number of columns in the "Changes" sheet

yChangesLastRow = yChanges.Range("A" & Rows.Count).End(xlUp).Row                                    'Finds the last row in the "Changes" sheet & counts the number of rows

yChangesLastRow = yChangesLastRow - 2                                                               '-2 from the number of rows to account for the header & Vlookup (2nd) column

z = 6                                                                                               'Sets variable "z" to start with the first parameter in the "Changes" sheet (Column "F")

    For x = 31 To Parameters + 31                                                                   'Sets variable "x" to start from the first Parameter in the "Operator" sheet to the last row

        With yChanges                                                                               'With the "Changes" sheet do the following

            Dim IndexRng As Range                                                                   'Declaring variable as a range
            Set IndexRng = .Range(.Cells(3, z), .Cells(yChangesLastRow, z))                         'Sets range variable as the index lookup array (Pending Changes entries)

            Dim MatchRng As Range                                                                   'Declaring variable as a range
            Set MatchRng = .Range("A3:A" & yChangesLastRow)                                         'Sets range variable as the match lookup array (Pending changes "Keys" only)

        End With                                                                                    'Ending the "With statement"

    Dim matchNum As Variant                                                                         'Declaring variable as general datatype
    matchNum = Application.Match(Sheet1.Range("H4").Value, MatchRng, 0)                             'Sets variable equal to the Match function to find the "Key" in the "Changes" sheet

                If Not IsError(matchNum) Then                                                       'Checking if the "Key" is in the "Changes" sheet (True or False)

                    OperatorWs.Range("N" & x).Value = Application.Index(IndexRng, matchNum)         'True: Sets the Changes Pending Approval parameters in the "Operator" sheet

                Else                                                                                'False: no match was found for the "Key" (Part & Process) in the "Changes sheet

                    Exit Sub                                                                        'End the macro

                End If                                                                              'End the "IF" statement
    
    z = z + 1                                                                                       '+1 to execute the "For" statement with the next (lookup) parameter

    Next x                                                                                          'Executes the "For" statement with the next "x" value (+1 until it reaches the "Parameters + 31" integer)

OperatorWs.Protect "123"                                                                            'Protect the "Operator" sheet
    
y.Save                                                                                              'Save the database Workbook

y.Close False                                                                                       'Close the database Workbook

End If                                                                                              'End the "IF" statement

Application.ScreenUpdating = True                                                                   'Must be "True" after running the code to be able to Read/Write the Workbook

End Sub                                                                                             'End the macro
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
I have some doubts:
- First, how long does your macro take?
- In these lines you have 2 sheets "Sheet1" and "OperatorWs" is the same sheet?

VBA Code:
    matchNum = Application.Match(Sheet1.Range("H4").Value, MatchRng, 0)
      OperatorWs.Range("N" & x).Value = Application.Index(IndexRng, matchNum)

- Range("H4").Value, is it a formula or a fixed value?

- Why do you use the Calculate event?
- Do you have other formulas on the sheet?

- OperatorWs.Range("N" & x).Value
Every time you write in column N, does any information on the sheet change that influences the following search?

If there are too many doubts, maybe you can explain your process with some samples of your sheets.
You can put the examples using XL2BB tool, see my signature. Replace your sensitive data with generic data.
 
Upvote 0
I have some doubts:
- First, how long does your macro take?
- In these lines you have 2 sheets "Sheet1" and "OperatorWs" is the same sheet?

VBA Code:
    matchNum = Application.Match(Sheet1.Range("H4").Value, MatchRng, 0)
      OperatorWs.Range("N" & x).Value = Application.Index(IndexRng, matchNum)

- Range("H4").Value, is it a formula or a fixed value?

- Why do you use the Calculate event?
- Do you have other formulas on the sheet?

- OperatorWs.Range("N" & x).Value
Every time you write in column N, does any information on the sheet change that influences the following search?

If there are too many doubts, maybe you can explain your process with some samples of your sheets.
You can put the examples using XL2BB tool, see my signature. Replace your sensitive data with generic data.
Hello Dante,

- So I have tested it and it seems to take 6 seconds to execute so far
- Yes, Sheet 1 and OperatorWS are the same sheet

- Range("H4").Value Is not a fixed value and has the following formula in the cell: =UPPER(CONCATENATE(Operator!E4,VLOOKUP(Operator!E5,H10:N76,7,FALSE)))

- I thought that whenever a change to Range("H4").Value was made that only then is the Calculate event triggered, but it turns out If Not Intersect(Range("H4"), Range("45")) Is Nothing Then really seems to be doing nothing for me in this case and anytime anything is changed on this worksheet then the Calculate event is triggered
- I don't have any other formula's inside the sheet where Calculate Event is, which is why I'm only seeing the event get triggered by the only change that can take place in the sheet, hence why I thought
If Not Intersect(Range("H4"), Range("45")) Is Nothing Then was triggering the Calculate Event

- Regarding
Code:
OperatorWs.Range("N" & x).Value
Column "N" doesn't change, but I would like the Index and Match application to fill in cells "N31" (which is the initial starting value "x=31" in the "For" statement) up to the last desired parameter (which is the last ending value "Parameters + 31" in the "For" statement, I have "Parameters" defined as Parameters = yChanges.Range("F1:CL1").Columns.Count
Basically I have the values from "F" to "CL" (84 Columns) transposed into "N31:N115" (N31 + 84 = N115). Also, in this case I have it going from "F" to "CL", but if I want to use this for another database then I would like to be able to update the last parameters constraint "CL" and have the last filled in cell of "N" change respectively.


Please let me know if this makes sense.
 
Last edited:
Upvote 0
I have also added Application.EnableEvents = False right below the Worksheet_Calculate event, and
Application.EnableEvents = True at the end of the worksheet, which seems to have increased my speed (initially it was a t 10 seconds, it's not at 6). I am also trying to use Private Sub Worksheet_Change(ByVal Target As Range) instead of Worksheet_Calculate
 
Upvote 0
Also, why is my Worksheet_Calculate targeting the entire sheet being changed instead of just If Not Intersect(Range("H5"), Range("H5")) Is Nothing Then
 
Upvote 0
I still have the doubt.
- You have a cycle.
- In cell H4 you have a value, let's say "hiworld"
- Look "hiworld" in the "Changes" sheet.
- In the next cycle, the value of H4 has already changed or is it still the same value?

If the value is the same in each cycle then try the following.
It is a small test.
Based on my test data, it gets the same results as your macro.

VBA Code:
Sub Test_1()
  Dim wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
  Dim f As Range
  
  Application.ScreenUpdating = False
  
  Set sh1 = ThisWorkbook.Worksheets("Operator")
  Set y = Workbooks.Open(Filename:="\Databases\Database_IRR 200-2S.xlsm", Password:="Swarf")
  Set sh2 = wb2.Sheets("Changes")
  Set f = sh2.Range("A:A").Find(sh1.Range("H4"), , xlValues, xlWhole)
  If Not f Is Nothing Then
    sh1.Range("N31").Resize(85).Value = Application.Transpose(f.Offset(, 5).Resize(1, 85).Value)
  End If
  wb2.Close False
End Sub

If it's not what you need, then you could upload a sample of your 2 books to the cloud.

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
I still have the doubt.
- You have a cycle.
- In cell H4 you have a value, let's say "hiworld"
- Look "hiworld" in the "Changes" sheet.
- In the next cycle, the value of H4 has already changed or is it still the same value?

If the value is the same in each cycle then try the following.
It is a small test.
Based on my test data, it gets the same results as your macro.

VBA Code:
Sub Test_1()
  Dim wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
  Dim f As Range

  Application.ScreenUpdating = False

  Set sh1 = ThisWorkbook.Worksheets("Operator")
  Set y = Workbooks.Open(Filename:="\Databases\Database_IRR 200-2S.xlsm", Password:="Swarf")
  Set sh2 = wb2.Sheets("Changes")
  Set f = sh2.Range("A:A").Find(sh1.Range("H4"), , xlValues, xlWhole)
  If Not f Is Nothing Then
    sh1.Range("N31").Resize(85).Value = Application.Transpose(f.Offset(, 5).Resize(1, 85).Value)
  End If
  wb2.Close False
End Sub

If it's not what you need, then you could upload a sample of your 2 books to the cloud.

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
Thank you for the suggestion, here is what I have (some minor tweaks):

Code:
Sub Trial()
  Dim wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
  Dim f As Range

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

  Set sh1 = ThisWorkbook.Worksheets("Operator")
  Set wb2 = Workbooks.Open(Filename:="\Databases\Database_IRR 200-2S.xlsm", Password:="Swarf")
  Set sh2 = wb2.Sheets("Changes")
  Set f = sh2.Range("A2:A100000").Find(sh1.Range("H4"), , xlValues, xlWhole)
  If Not f Is Nothing Then '
    sh1.Unprotect "123"
    sh1.Range("N31").Resize(85).Value = Application.Transpose(f.Offset(, 5).Resize(, 85).Value)
    sh1.Protect "123"
  End If

  wb2.Close False

  'Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.ScreenUpdating = True

End Sub

I just had a question regarding the range inside of Set f = sh2.Range("A2:A100000").Find(sh1.Range("H4"), , xlValues, xlWhole) and why the find function doesn't use the "A2" (the first lookup value), and it finds values inside of row A3 (not a big deal just wondering the logic).

Also, how can I make this macro execute anytime a change is made to cell H4 inside of sh1, should I use a Worksheet_Calculate Event, a Workheet_Change Event or a Worksheet_SelectionChange Event possibly?
 
Last edited:
Upvote 0
Set f = sh2.Range("A2:A100000

why the find function doesn't use the "A2" I(the first lookup value)

The find method starts in the next cell after the first cell in the range, your range is A2, then the next cell is A3.
If you want it to start at A2, then change the range to A1:A100000.

____________________________________________________
Before putting the macro in an event I wanted to know if it is really what you need.
 
Upvote 0
The find method starts in the next cell after the first cell in the range, your range is A2, then the next cell is A3.
If you want it to start at A2, then change the range to A1:A100000.

____________________________________________________
Before putting the macro in an event I wanted to know if it is really what you need.
Awesome simple explanation, thank you!

I put the code inside of "sheet 1" (the operator sheet) with a Worksheet_Change (ByVal Target As Range) event and I was wondering if you have any feedback on improving the speed slightly or where I should be placing Application.ScreenUpdating = False , Application.EnableEvents = False and Application.Calculation = xlCalculationManual.

Here is the final code I have comeup with inside of sh1:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
  Dim f As Range

  Application.ScreenUpdating = False

  If Not Intersect(Target, Range("E4:E5")) Is Nothing Then

  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

  Set sh1 = ThisWorkbook.Worksheets("Operator")
  Set wb2 = Workbooks.Open(Filename:=" \Databases\Database_IRR 200-2S.xlsm", Password:="Swarf")
  Set sh2 = wb2.Sheets("Changes")
  Set f = sh2.Range("A2:A100000").Find(sh1.Range("H4"), , xlValues, xlWhole)
  If Not f Is Nothing Then '
    sh1.Unprotect "123"
    sh1.Range("N31").Resize(85).Value = Application.Transpose(f.Offset(, 5).Resize(, 85).Value)
    sh1.Protect "123"
  End If

  wb2.Close False

  End If

  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.ScreenUpdating = True

End Sub
 
Upvote 0
Range("H4").Value Is not a fixed value and has the following formula in the cell: =UPPER(CONCATENATE(Operator!E4,VLOOKUP(Operator!E5,H10:N76,7,FALSE)))

You capture data in E4 or it's formula.
You capture data in E5 or it's formula.

If you capture data in those cells, then they can be a trigger for the change event.
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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