Question about VBA macro using Index Match with 2 criteria

[kiri]

Hello

I am trying to use VBA to get values from 1 worksheet into another with index match based on 2 criteria. The problem is that i need the script to return a value only when BOTH criteria find a match. My code appears to return a value even when only one of my criteria matches. My knowledge of VBA is very limited, im learning as i go, and i dont know why its behaving this way. Bellow is the code that i got so far.

I am also uploading 2 minisheets (because im working on a workbook with 2 worksheets). The first minisheet represents the "cart" in my code and the second the"STK".

If you look in the first minisheet in the last row of column P it returned a value (1.65) from row 43 of the 2nd minisheet where only 1 of my criteria match. My second criteria which in this case should have a value of "1" doesnt match the value in cell E43 which has a value of "4".

How can i get my code to only write a value if both of the criteria match?

I hope i managed to describe my issue well and i thank you in advance for your time, if you need more info let me know.

Sub indexmatchsheets()

    Dim cart As Worksheet, STK As Worksheet
    Dim cartLastRow As Long, STKLastRow As Long, x As Long
    Dim Indexrng As Range, matchrng As Range, matchrng1 As Range
    
    Set STK = ThisWorkbook.Worksheets("STK8331.RPT")
    Set cart = ThisWorkbook.Worksheets("oc_product")
    
    STKLastRow = STK.Range("D" & Rows.Count).End(xlUp).Row
    cartLastRow = cart.Range("A" & Rows.Count).End(xlUp).Row
    
    Set Indexrng = STK.Range("D2:D" & STKLastRow)
    Set matchrng = STK.Range("A2:A" & STKLastRow)
    Set matchrng1 = STK.Range("E2:E" & STKLastRow)
    
    For x = 2 To cartLastRow
        On Error Resume Next
        cart.Range("P" & x).Value = Application.WorksheetFunction.Index(Indexrng, _
        Application.WorksheetFunction.Match(cart.Range("D" & x).Value, matchrng, 0), _
        Application.WorksheetFunction.Match(cart.Range("T2").Value, matchrng1, 0))
        
    Next x
    


End Sub

test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
2	57	LE730094	LE730094	LE730094						20	6		5	1	3.17	3.17
3	58	LE730091	LE730091	LE730091						20	6		5	1	2.4	2.4
4	59	LE730037	LE730037	LE730037						20	6		5	1	10.3	10.84
5	51	LE730076	LE730076	LE730076						200	6		5	1	6.51	6.51
6	52	LE730056	LE730056	LE730056						20	6		5	1	8.4	9.66
7	53	LE730057	LE730057	LE730057						20	6		5	1	18.25	19.33
8	54	LE730095	LE730095	LE730095						20	6		5	1	2	2
9	55	LE730096	LE730096	LE730096						20	6		5	1	3.3	3.3
10	56	LE730092	LE730092	LE730092						20	6		5	1	2.6	2.6
11	115	FLA2		FLA201						10000	6		0	1	0.55	0
12	63	LE684603	LE684603	LE684603						20	6		5	1	31	0
13	62	LE730012	LE730012	LE730012						40	6		5	1	7.89	8.32
14	60	LE730023	LE730023	LE730023						20	6		5	1	9.1	9.8
15	61	LE730029	LE730029	LE730029						20	6		5	1	21	21
16	49	LE684604	LE684604	LE684604						20	6		5	1	42	0
17	50	LE730066	LE730066	LE730066						200	6		5	1	3.3	3.3
18	64	LE684636	LE684636	LE684636						20	6		5	1	37	0
19	65	LE684570	LE684570	LE684570						20	6		5	1	30	0
20	66	LE684620	LE684620	LE684620						20	6		5	1	39	0
21	67	LE684602	le684602	LE684602						20	6		5	1	38	0
22	68	LE684553	LE684553	LE684553						20	6		5	1	23	0
23	69	LE684554	LE684554	LE684554						20	6		5	1	39	0
24	70	LE572035	LE572035	LE572035						20	6		5	1	4.5	0
25	71	LE572005	LE502005	LE572005						20	6		5	1	4.2	0
26	72	LE572341	LE572341	LE572341						20	6		5	1	1.5	0
27	73	LE572220	LE572220	LE572220						20	6		5	1	22	0
28	74	CU9000S	CU9000S	CU9000S						200	6		11	1	4.23	0
29	75	CU7000S	CU7000S	CU7000S						200	6		11	1	3.16	0
30	76	CU9903	CU9903	CU9903						10	6		11	1	17.32	0
31	79	LE730000	LE730000	LE730000						200	6		5	1	1.83	1.65
oc_product

test.xlsm
	A	B	C	D	E
1	LE730000	SWITCH 10A 1G 1W SYNERGY	PCS	1.830	1
2	LE730001	SWITCH 10A 1G 2W SYNERGY	PCS	2.200	1
3	LE730002	SWITCH 10A 2G 2W SYNERGY	PCS	4.200	1
4	LE730003	SWITCH 10A 3G 2W SYNERGY	PCS	6.300	1
5	LE730004	SWITCH 10A 4G 2W SYNERGY	PCS	11.300	1
6	LE730005	SWITCH 10A INTER SYNERGY	PCS	6.500	1
7	LE730006	SWITCH 10A 6G 2W SYNERGY	PCS	16.720	1
8	LE730011	SWITCH PRESS SYNERGY	PCS	4.000	1
9	LE730012	SWITCH 20A DP SYNERGY	PCS	8.320	1
10	LE730023	SWITCH 45A DP WITH NEON SYN COOKER 1G	PCS	9.800	1
11	LE730029	COOKER LEGRAND WITH SOCKET SYNERGY	PCS	21.000	1
12	LE730033	FUSE CONN UNIT NO SWIT SYNER	PCS	11.680	1
13	LE730037	SWITCH FUSE CONN UNIT SYNERGY	PCS	10.840	1
14	LE730040	SOCKET TV 1G PASS THROUGH MALE SYNE	PCS	4.900	1
15	LE730046	DIMMER 1G 2W 250W SYNERGY	PCS	28.000	1
16	LE730047	DIMMER 2G 2W 250W SYNERGY	PCS	64.000	1
17	LE730048	DIMMER 1G 2W 400W SYNERGY	PCS	38.000	1
18	LE730050	SOCKET TEL.MASTER 1G SYNERGY	PCS	7.500	1
19	LE730051	SOCKET TEL.SECONDARY 1G SYNERG	PCS	6.300	1
20	LE730056	SOCKET CAT6 RJ45 1G SYNERGY	PCS	9.660	1
21	LE730057	SOCKET CAT6 RJ45 2G SYNERGY	PCS	19.330	1
22	LE730058	LAMP RED LED SYNERGY	PCS	2.450	1
23	LE730066	SOCKET OUTLET 1G SYNERGY	PCS	3.300	1
24	LE730067	SOCKET OUTL 1G SYNER NON STAND	PCS	10.920	1
25	LE730068	SOCKET OUTLET 1G 5A UNSWIT SYNERGY	PCS	7.560	1
26	LE730070	SOCKET OUTLET 2G DP SYNERGY	PCS	10.760	1
27	LE730071	SOCKET OUTLET 2G DP WITH NEON SYNERGY	PCS	15.780	1
28	LE730076	SOCKET OUTLET 2G SYNERGY	PCS	6.510	1
29	LE730077	SOCKET OUTL 2G SYNER NON STAND	PCS	23.000	1
30	LE730078	SOCKET OUTLET 1G SYNERGY WITH USB CHARGER	PCS	36.970	1
31	LE730079	SOCKET OUTLET 2G SYNERGY WITH 2 USB CHARGER	PCS	74.000	1
32	LE730090	SHAVER SOCKET 240/120V SYNERGY	PCS	50.900	1
33	LE730091	PLATE CARRIER 1G 1MOD SYNERGY	PCS	2.400	1
34	LE730092	PLATE CARRIER 1G 2MOD SYNERGY	PCS	2.600	1
35	LE730094	PLATE CARRIER 2G 4MOD SYNERGY	PCS	3.170	1
36	LE730095	PLATE BLANC 1G SYNERGY	PCS	2.000	1
37	LE730096	PLATE BLANC 2G SYNERGY	PCS	3.300	1
38	37			0
39		Items		0
40				0
41				0
42				0
43	LE730000		PCS	1.650	4
44	LE730001		PCS	1.950	2
45	LE730002		PCS	3.820	2
46	LE730003		PCS	5.700	2
47	LE730004		PCS	10.200	2
48	LE730005		PCS	5.880	2
49	LE730006		PCS	15.500	2
STK8331.RPT

Cell Formulas
Range	Formula
A38	A38	=SUBTOTAL(3,A1:A37)

 

[Legacy 143009]

Sub indexmatchsheets()

    Dim cart As Worksheet, STK As Worksheet
    Dim cartLastRow As Long, STKLastRow As Long, x As Long
    Dim Indexrng As Range, matchrng As Range, matchrng1 As Range
   
    Set STK = ThisWorkbook.Worksheets("STK8331.RPT")
    Set cart = ThisWorkbook.Worksheets("oc_product")
   
    STKLastRow = STK.Range("D" & Rows.Count).End(xlUp).Row
    cartLastRow = cart.Range("A" & Rows.Count).End(xlUp).Row
   
    Set Indexrng = STK.Range("D2:D" & STKLastRow)
    Set matchrng = STK.Range("A2:A" & STKLastRow)
    Set matchrng1 = STK.Range("E2:E" & STKLastRow)

    With Application.WorksheetFunction
    For x = 2 To cartLastRow
        On Error Resume Next
        cart.Range("P" & x).Value = .Index(Indexrng, .Match(cart.Range("D" & x).Value, matchrng, 0) + .Match(cart.Range("T2").Value, matchrng1, 0) - 1)
    Next x
    End With

End Sub

 

[James006]

Hi,
You could test following

Sub IndexMatchSheets()

Dim cart As Worksheet, STK As Worksheet
Dim cartLastRow As Long, STKLastRow As Long, x As Long
Dim Indexrng As Range, matchrng As Range, matchrng1 As Range
Dim res1, res2
    
    Set STK = ThisWorkbook.Worksheets("STK8331.RPT")
    Set cart = ThisWorkbook.Worksheets("oc_product")
    
    STKLastRow = STK.Range("D" & Rows.Count).End(xlUp).Row
    cartLastRow = cart.Range("A" & Rows.Count).End(xlUp).Row
    
    Set Indexrng = STK.Range("D2:D" & STKLastRow)
    Set matchrng = STK.Range("A2:A" & STKLastRow)
    Set matchrng1 = STK.Range("E2:E" & STKLastRow)
    
    For x = 2 To cartLastRow
        res1 = Application.WorksheetFunction.Match(cart.Range("D" & x).Value, matchrng, 0)
        res2 = Application.WorksheetFunction.Match(cart.Range("T2").Value, matchrng1, 0)
        If Not IsError(res1) And Not IsError(res2) Then
            cart.Range("P" & x).Value = Application.WorksheetFunction.Index(Indexrng, _
            res1, _
            res2)
        End If
    Next x

End Sub

 

[kiri]

Sub indexmatchsheets()

    Dim cart As Worksheet, STK As Worksheet
    Dim cartLastRow As Long, STKLastRow As Long, x As Long
    Dim Indexrng As Range, matchrng As Range, matchrng1 As Range
  
    Set STK = ThisWorkbook.Worksheets("STK8331.RPT")
    Set cart = ThisWorkbook.Worksheets("oc_product")
  
    STKLastRow = STK.Range("D" & Rows.Count).End(xlUp).Row
    cartLastRow = cart.Range("A" & Rows.Count).End(xlUp).Row
  
    Set Indexrng = STK.Range("D2:D" & STKLastRow)
    Set matchrng = STK.Range("A2:A" & STKLastRow)
    Set matchrng1 = STK.Range("E2:E" & STKLastRow)

    With Application.WorksheetFunction
    For x = 2 To cartLastRow
        On Error Resume Next
        cart.Range("P" & x).Value = .Index(Indexrng, .Match(cart.Range("D" & x).Value, matchrng, 0) + .Match(cart.Range("T2").Value, matchrng1, 0) - 1)
    Next x
    End With

End Sub

Hi, thank you for the fast reply. I just tested it but it has exactly the same result as my original code.

 

[kiri]

Hi,
You could test following

Sub IndexMatchSheets()

Dim cart As Worksheet, STK As Worksheet
Dim cartLastRow As Long, STKLastRow As Long, x As Long
Dim Indexrng As Range, matchrng As Range, matchrng1 As Range
Dim res1, res2
   
    Set STK = ThisWorkbook.Worksheets("STK8331.RPT")
    Set cart = ThisWorkbook.Worksheets("oc_product")
   
    STKLastRow = STK.Range("D" & Rows.Count).End(xlUp).Row
    cartLastRow = cart.Range("A" & Rows.Count).End(xlUp).Row
   
    Set Indexrng = STK.Range("D2:D" & STKLastRow)
    Set matchrng = STK.Range("A2:A" & STKLastRow)
    Set matchrng1 = STK.Range("E2:E" & STKLastRow)
   
    For x = 2 To cartLastRow
        res1 = Application.WorksheetFunction.Match(cart.Range("D" & x).Value, matchrng, 0)
        res2 = Application.WorksheetFunction.Match(cart.Range("T2").Value, matchrng1, 0)
        If Not IsError(res1) And Not IsError(res2) Then
            cart.Range("P" & x).Value = Application.WorksheetFunction.Index(Indexrng, _
            res1, _
            res2)
        End If
    Next x

End Sub

Hi i tested it and i get runtime error "unable to get the match property of the worksheetfunction class on the line "res1 = Application.WorksheetFunction.Match(cart.Range("D" & x).Value, matchrng, 0)".

 

[James006]

Doesn't that means exactly what you intended ... i.e. catch the specific case whenever there is no match ... ?

 

[James006]

May be, you can test following:

Sub IndexMatchSheetsV2()

Dim cart As Worksheet, STK As Worksheet
Dim cartLastRow As Long, STKLastRow As Long, x As Long
Dim Indexrng As Range, matchrng As Range, matchrng1 As Range
Dim res1, res2
    
    Set STK = ThisWorkbook.Worksheets("STK8331.RPT")
    Set cart = ThisWorkbook.Worksheets("oc_product")
    
    STKLastRow = STK.Range("D" & Rows.Count).End(xlUp).Row
    cartLastRow = cart.Range("A" & Rows.Count).End(xlUp).Row
    
    Set Indexrng = STK.Range("D2:D" & STKLastRow)
    Set matchrng = STK.Range("A2:A" & STKLastRow)
    Set matchrng1 = STK.Range("E2:E" & STKLastRow)
    
    For x = 2 To cartLastRow
        res1 = Application.WorksheetFunction.Match(cart.Range("D" & x).Value, matchrng, 0)
        If IsError(res1) Then GoTo Line1:
        res2 = Application.WorksheetFunction.Match(cart.Range("T2").Value, matchrng1, 0)
        If IsError(res2) Then GoTo Line1:
            ' No Errors - Perform Index
            cart.Range("P" & x).Value = Application.WorksheetFunction.Index(Indexrng, _
            res1, _
            res2)
Line1:
    Next x

End Sub

 

[kiri]

Doesn't that means exactly what you intended ... i.e. catch the specific case whenever there is no match ... ?

Now i understand what you did. With your code i get the error and i can see on which line the error. But i im not trying to catch it, i want to skip it.

I dont want it to return a result unless both my criteria find a match. If you see in my first minisheet column P is populated by 0 (zeros) and my code overwrites those 0 with values from the second minisheet. In this case cell P31 of my first minisheet should have been 0 because my second match criteria is not satisfied so it shouldn't add a value there.
In other words what i am trying to achieve is the same as if this was an index match array formula in the workbook. Specifically i want to to with VBA exactly what this formula does:

{=INDEX(STK8331.RPT!D1:D126,MATCH(1,(STK8331.RPT!A1:A126=oc_product!D31)*(oc_product!T2=STK8331.RPT!E1:E126),0),1)}

This formula returns #N/A in cell P31. I dont mind it if its "0" or "error" or anything else instead of "#N/A" i just dont want it to grab values from the other worksheet if all the match criteria are not fulfilled.

 

[James006]

Have you tested the macro posted in message #7 ... to skip errors ... ?

If it does not produce the expected result, we can always replicate the formula you just posted ...

 

[kiri]

Have you tested the macro posted in message #7 ... to skip errors ... ?

If it does not produce the expected result, we can always replicate the formula you just posted ...

I forgot to mention it but the macro in message 7 had the same result as the one in message 3, it doesn't skip the error.
In the end yes what i want to do is replicate the formula that i just posted for the entire column P in oc_products. To be honest that's what i thought my original VBA code was doing.
As a formula i just write it in 1 cell and the copy paste it in the rest of the column.