SOLVED

Convert index match with multiple criteria into VBA

Iron Contributor

I would like to translate the index match formula below into a macro.  The excel formula works perfectly but when i code it using a for loop but not sure why the values are populated as #NA from C2 to last row..

 

Excel Formula : 

=INDEX('[640910 690606641710_Jan to Jul''22_working.xlsx]Sheet1'!$D$2:$D$5000,MATCH(1,(C2='[640910 690606641710_Jan to Jul''22_working.xlsx]Sheet1'!$C$2:$C$5000)*(P2='[640910 690606641710_Jan to Jul''22_working.xlsx]Sheet1'!$P$2:$P$5000),0))

 

VBA code as follows:

Sub vlkupfromworkingfile()

Dim ws As Worksheet
Dim wsLastrow       As Long
Dim i               As Long

Set ws = Sheet1

ws.Range("D:D").EntireColumn.Insert
ws.Range("D1").Value = "Remarks"

wsLastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 2 To wsLastrow
    
    On Error Resume Next
    
    With ws.Range("D" & i)
        .Formula = "='C:\Users\hrhquek\Desktop\[640910 690606641710_Jan to Jul''22_working.xlsx]Sheet1'!$D$2:$D$5000,MATCH(1,(C2='C:\Users\hrhquek\Desktop\[640910 690606641710_Jan to Jul''22_working.xlsx]Sheet1'!$C$2:$C$5000)*(P2='C:\Users\hrhquek\Desktop\[640910 690606641710_Jan to Jul''22_working.xlsx]Sheet1'!$P$2:$P$5000),0))"
        .Value = .Value
    End With
    
Next i

End Sub

 

appreciate the assistance in advance!

13 Replies

@hrh_dash 

There is no need to loop. The following is much more efficient:

Sub vlkupfromworkingfile()
    Dim ws        As Worksheet
    Dim wsLastrow As Long
    Const sSheet  As String = "'C:\Users\hrhquek\Desktop\[640910 690606641710_Jan to Jul''22_working.xlsx]Sheet1'!"

    Set ws = Sheet1
    ws.Range("D:D").EntireColumn.Insert
    ws.Range("D1").Value = "Remarks"
    wsLastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    On Error Resume Next
    With ws.Range("D2:D" & wsLastrow)
        .Formula = "=" & sSheet & "$D$2:$D$5000,MATCH(1,(C2=" & sSheet & "$C$2:$C$5000)*(P2=" & sSheet & "$P$2:$P$5000),0))"
        .Value = .Value
    End With
End Sub

@Hans Vogelaar , i just realized that i have omitted an index in the macro.

 

would it be correct if i were to input the index as follows?

 With ws.Range("D2:D" & wsLastrow)
        .Formula = "= Index( " & sSheet & "$D$2:$D$5000,MATCH(1,(C2=" & sSheet & "$C$2:$C$5000)*(P2=" & sSheet & "$P$2:$P$5000),0))"
        .Value = .Value
           
    End With

 

@hrh_dash 

Yes, that looks OK.

@Hans Vogelaar ,not sure why it still populate as #NA.. Tried removing .Formula and .Value, it still shows #NA..

 

Tried using ws.Range("D2:D" & wsLastrow) = ws.Evaluate(....) it shows #value.. i don't think the references is wrong because when i manually input the formula into the cell, it works.

 

Is there another way for this?

@hrh_dash 

Could you attach a sample workbook (without sensitive data), or if that is not possible, make it available through OneDrive, Google Drive, Dropbox or similar? Alternatively, you can attach it to a private message to me. Thanks in advance.

@Hans Vogelaar ,attaching the files for your reference.

 

macro test workbook will be the file containing the macro.

The code will be under Sub vlkupfromworkingfile()

Attaching the files for your reference.

 

Again, appreciate the help.

best response confirmed by hrh_dash (Iron Contributor)
Solution

@hrh_dash 

Try this version:

Sub vlkupfromworkingfile()
    Dim ws As Worksheet
    Dim wsLastrow As Long
    Dim r As Long
    Const sSheet As String = "'C:\Users\hrhquek\Desktop\[working file.xlsx]Sheet1'!"

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set ws = Sheet1
    ws.Range("D:D").EntireColumn.Insert
    ws.Range("D1").Value = "Remarks"
    wsLastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    'On Error Resume Next
    For r = 2 To wsLastrow
        ws.Range("D" & r).Value = Evaluate("= Index(" & sSheet & "$D$2:$D$5000,MATCH(1,(" & _
            sSheet & "$C$2:$C$5000=C" & r & ")*(" & sSheet & "$P$2:$P$5000=P" & r & "),0))")
    Next r
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

@Hans Vogelaar , the code works perfectly. thanks and appreciate the assist!

hi @Hans Vogelaar , i tried amending the respective filepath below to where it was saved:

 

Const sSheet  As String = "'C:\Users\hrhquek\Desktop\report\[640910690606641710_JantoJul(working).xlsm]Sheet1'!"

 

and it keeps populating #value! despite there is no change in the format. File path is gotten from the cmd which should not be invalid.

 

For example, the source file (containing the code) contains data from Jan22 to Jul22.

 

The new file contains data from Jan22 to Aug22. Therefore, i would copy the code from the source file and paste it into the new file so as to execute a lookup from the source file.

 

Therefore, this results in the cell to populates #value!

 

 

 

@hrh_dash 

I'm afraid it's impossible for me to know what is wrong without seeing the workbooks.

Hi @Hans Vogelaar , attaching both file. 

 

aug22 - copy workbook will be taking reference from 640910690606641710_JantoJul(working)_Copy workbook

 

Hence, the macro from 640910690606641710_JantoJul(working)_Copy workbook will be copied into aug22 - copy workbook.

 

 

@hrh_dash 

Thank you. The problem is that the string to evaluate has become longer than the maximum length of 255, because of the long filename. Can you shorten the name to for example JantoJul.xlsm ?

Alright noted on this. Thanks and appreciate the advice
1 best response

Accepted Solutions
best response confirmed by hrh_dash (Iron Contributor)
Solution

@hrh_dash 

Try this version:

Sub vlkupfromworkingfile()
    Dim ws As Worksheet
    Dim wsLastrow As Long
    Dim r As Long
    Const sSheet As String = "'C:\Users\hrhquek\Desktop\[working file.xlsx]Sheet1'!"

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set ws = Sheet1
    ws.Range("D:D").EntireColumn.Insert
    ws.Range("D1").Value = "Remarks"
    wsLastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    'On Error Resume Next
    For r = 2 To wsLastrow
        ws.Range("D" & r).Value = Evaluate("= Index(" & sSheet & "$D$2:$D$5000,MATCH(1,(" & _
            sSheet & "$C$2:$C$5000=C" & r & ")*(" & sSheet & "$P$2:$P$5000=P" & r & "),0))")
    Next r
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

View solution in original post