Index match VBA taking too long

youbitto

youbitto

New Member
Joined
Jun 8, 2022
Messages
33
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
Hello!

I have this code to index match multiple columns from 2 different sheets at ones but the it takes too long to complete, the code has a column change to text format and another one to run mid()

so my requests are :

1. make the code run faster

2. make a percentage of completion
VBA Code: 
Sub INDEX_MATCH()

Dim k As Long

Dim i As Long

i = ActiveSheet.UsedRange.Rows.Count



' k is the column number

For k = 5 To i



Sheets("listCreance").Cells(k, 17).Value = WorksheetFunction.Index(Sheets("List Clients").Range("H:H"), WorksheetFunction.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)) 'Adresse
Sheets("listCreance").Cells(k, 18).Value = WorksheetFunction.Index(Sheets("List Clients").Range("U:U"), WorksheetFunction.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)) 'N Cpt
Sheets("listCreance").Cells(k, 19).Value = WorksheetFunction.Index(Sheets("List Clients").Range("D:D"), WorksheetFunction.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)) 'Nom Client
Sheets("listCreance").Cells(k, 20).Value = WorksheetFunction.Index(Sheets("List Clients").Range("F:F"), WorksheetFunction.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)) 'Reference
Sheets("listCreance").Cells(k, 21).Value = WorksheetFunction.Index(Sheets("List Clients").Range("M:M"), WorksheetFunction.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)) 'Tarif
Sheets("listCreance").Cells(k, 22).Value = WorksheetFunction.Index(Sheets("List Clients").Range("R:R"), WorksheetFunction.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)) 'Etat
Sheets("listCreance").Cells(k, 25).Value = WorksheetFunction.Index(Sheets("List Clients").Range("S:S"), WorksheetFunction.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)) 'Date Résiliation

Sheets("listCreance").Cells(k, 23).Value = Mid(Sheets("listCreance").Cells(k, 21), 3, 2)
Sheets("listCreance").Cells(k, 24).Value = Mid(Sheets("listCreance").Cells(k, 20), 1, 7)

On Error Resume Next

Next k

Sheets("listCreance").Columns("T:T").NumberFormat = "000000000000000"

End Sub
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
Try something like this...

VBA Code: 
Sub INDEX_MATCH()
   
    Dim k         As Long
    Dim m         As Variant
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    For k = 5 To ActiveSheet.UsedRange.Rows.Count    ' k is the row number
   
        m = Application.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)
   
        If Not IsError(m) Then
       
            With Sheets("listCreance")
   
                .Cells(k, 17).Value = Sheets("List Clients").Range("H" & m).Value    'Adresse
                .Cells(k, 18).Value = Sheets("List Clients").Range("U" & m).Value    'N Cpt
                .Cells(k, 19).Value = Sheets("List Clients").Range("D" & m).Value    'Nom Client
                .Cells(k, 20).Value = Sheets("List Clients").Range("F" & m).Value    'Reference
                .Cells(k, 21).Value = Sheets("List Clients").Range("M" & m).Value    'Tarif
                .Cells(k, 22).Value = Sheets("List Clients").Range("R" & m).Value    'Etat
                .Cells(k, 25).Value = Sheets("List Clients").Range("S" & m).Value    'Date Résiliation
               
                .Cells(k, 23).Value = Mid(.Cells(k, 21), 3, 2)
                .Cells(k, 24).Value = Mid(.Cells(k, 20), 1, 7)
           
            End With
        End If
   
    Next k
   
    Sheets("listCreance").Columns("T:T").NumberFormat = "000000000000000"
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
   
End Sub

There is even a faster way using arrays, but I'm too lazy to rewrite the entire code.
 
Last edited:
Upvote 0
AlphaFrog said:
Try something like this...

VBA Code: 
Sub INDEX_MATCH()
  
    Dim k         As Long
    Dim m         As Variant
  
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
  
    For k = 5 To ActiveSheet.UsedRange.Rows.Count    ' k is the row number
  
        m = Application.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)
  
        If Not IsError(m) Then
      
            With Sheets("listCreance")
  
                .Cells(k, 17).Value = Sheets("List Clients").Range("H" & m).Value    'Adresse
                .Cells(k, 18).Value = Sheets("List Clients").Range("U" & m).Value    'N Cpt
                .Cells(k, 19).Value = Sheets("List Clients").Range("D" & m).Value    'Nom Client
                .Cells(k, 20).Value = Sheets("List Clients").Range("F" & m).Value    'Reference
                .Cells(k, 21).Value = Sheets("List Clients").Range("M" & m).Value    'Tarif
                .Cells(k, 22).Value = Sheets("List Clients").Range("R" & m).Value    'Etat
                .Cells(k, 25).Value = Sheets("List Clients").Range("S" & m).Value    'Date Résiliation
              
                .Cells(k, 23).Value = Mid(.Cells(k, 21), 3, 2)
                .Cells(k, 24).Value = Mid(.Cells(k, 20), 1, 7)
          
            End With
        End If
  
    Next k
  
    Sheets("listCreance").Columns("T:T").NumberFormat = "000000000000000"
  
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
  
End Sub

There is even a faster way using arrays, but I'm too lazy to rewrite the entire code.
Click to expand...
Hello Mr. Alpha After trying this I get 'Overflow' error message
 

Attachments

  • image_2024-09-06_104238697.png
    image_2024-09-06_104238697.png
    4.6 KB · Views: 10
Upvote 0
The code @AlphaFrog provided works fine for me. Since it writes out line by line, what is the last line that it writes out and does it write out all the columns.
Is there anything unusual in the line it fails on ?
 
Upvote 0
Alex Blakenburg said:
The code @AlphaFrog provided works fine for me. Since it writes out line by line, what is the last line that it writes out and does it write out all the columns.
Is there anything unusual in the line it fails on ?
Click to expand...
yes it works until the line 17677
also nothing is unusual in that line
 
Upvote 0
So when it errors, k = 17677?

What is the value of m ?
What is the value in cell D17677 ?

Did you make any change to the code I suggested?
 
Upvote 0
AlphaFrog said:
So when it errors, k = 17677?

What is the value of m ?
What is the value in cell D17677 ?

Did you make any change to the code I suggested?
Click to expand...
I copy pasted your code without any modifications
the cell value of D17677 is like any other cell above and tried searching for it manually to see if it has anything unusual and it is fine
 

Attachments

  • image_2024-09-06_185155363.png
    image_2024-09-06_185155363.png
    106.6 KB · Views: 7
Upvote 0
I'm not sure what the issue is. It somehow has to do with your very large reference numbers.

Try this code. It should ignore errors and log them to the VBA Immediate window.

VBA Code: 
Sub INDEX_MATCH()
   
    Dim k         As Long
    Dim m         As Variant
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    On Error Resume Next
   
    For k = 5 To ActiveSheet.UsedRange.Rows.Count    ' k is the row number
   
        m = Worksheetfuntion.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)
   
        If Err.Number = 0 Then
       
            With Sheets("listCreance")
   
                .Cells(k, 17).Value = Sheets("List Clients").Range("H" & m).Value    'Adresse
                .Cells(k, 18).Value = Sheets("List Clients").Range("U" & m).Value    'N Cpt
                .Cells(k, 19).Value = Sheets("List Clients").Range("D" & m).Value    'Nom Client
                .Cells(k, 20).Value = Sheets("List Clients").Range("F" & m).Value    'Reference
                .Cells(k, 21).Value = Sheets("List Clients").Range("M" & m).Value    'Tarif
                .Cells(k, 22).Value = Sheets("List Clients").Range("R" & m).Value    'Etat
                .Cells(k, 25).Value = Sheets("List Clients").Range("S" & m).Value    'Date Résiliation
               
                .Cells(k, 23).Value = Mid(.Cells(k, 21), 3, 2)
                .Cells(k, 24).Value = Mid(.Cells(k, 20), 1, 7)
           
            End With
           
        Else
       
            Debug.Print k & ", " & Err.Number
            Err.Clear
           
        End If
   
    Next k
   
    On Error GoTo 0
   
    Sheets("listCreance").Columns("T:T").NumberFormat = "000000000000000"
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
   
End Sub
 
Upvote 0
AlphaFrog said:
I'm not sure what the issue is. It somehow has to do with your very large reference numbers.

Try this code. It should ignore errors and log them to the VBA Immediate window.

VBA Code: 
Sub INDEX_MATCH()
 
    Dim k         As Long
    Dim m         As Variant
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    On Error Resume Next
 
    For k = 5 To ActiveSheet.UsedRange.Rows.Count    ' k is the row number
 
        m = Worksheetfuntion.Match(Sheets("listCreance").Cells(k, 4).Value, Sheets("List Clients").Range("F:F"), 0)
 
        If Err.Number = 0 Then
     
            With Sheets("listCreance")
 
                .Cells(k, 17).Value = Sheets("List Clients").Range("H" & m).Value    'Adresse
                .Cells(k, 18).Value = Sheets("List Clients").Range("U" & m).Value    'N Cpt
                .Cells(k, 19).Value = Sheets("List Clients").Range("D" & m).Value    'Nom Client
                .Cells(k, 20).Value = Sheets("List Clients").Range("F" & m).Value    'Reference
                .Cells(k, 21).Value = Sheets("List Clients").Range("M" & m).Value    'Tarif
                .Cells(k, 22).Value = Sheets("List Clients").Range("R" & m).Value    'Etat
                .Cells(k, 25).Value = Sheets("List Clients").Range("S" & m).Value    'Date Résiliation
             
                .Cells(k, 23).Value = Mid(.Cells(k, 21), 3, 2)
                .Cells(k, 24).Value = Mid(.Cells(k, 20), 1, 7)
         
            End With
         
        Else
     
            Debug.Print k & ", " & Err.Number
            Err.Clear
         
        End If
 
    Next k
 
    On Error GoTo 0
 
    Sheets("listCreance").Columns("T:T").NumberFormat = "000000000000000"
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
End Sub
Click to expand...
This code doesn't give any results and no message pops up
 

Attachments

  • image_2024-09-06_193415655.png
    image_2024-09-06_193415655.png
    31.8 KB · Views: 3
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
VBA Index Match (Error Handling)
Replies
5
Views
530
kevin9999
K
HansM
  • Question Question
Looking for a specific number in a cell that can have multiple numbers separated by a comma (Using Mac Excel)
Replies
5
Views
291
Jeffrey Mahoney
Jeffrey Mahoney
M
  • Solved
Optimizing my rows to send e-mail to different address
Replies
2
Views
166
MasterBash
M
K
  • Question Question
How to shorten vba code without any problems
Replies
1
Views
266
kamranyd
K
J
  • Solved
VBA Code Error Unable to get the Match property of the WorksheetFunction class
Replies
8
Views
251
Jiraya_00
J

Forum statistics

Threads
1,223,703
Messages
6,173,972
Members
452,540
Latest member
haasro02

Share this page

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