VBA to complete Index/Match with 2 criteria

[Drrellik]

Time by week Master.xlsm
	A	B	C	D	E
1	ADAMS ANTONIO	8/26/2024	35	2024	13.5
2	ADAMS ANTONIO	8/27/2024	35	2024	14.93
3	ADAMS ANTONIO	8/28/2024	35	2024	13.77
4	ADAMS ANTONIO	8/29/2024	35	2024	14.52
5	ADAMS ANTONIO	8/30/2024	35	2024	13.33
6	ADAMS ANTONIO	Week 35 Total	35	2024	70.05
7	ADAMS KEVIN	8/27/2024	35	2024	14.93
8	ADAMS KEVIN	8/28/2024	35	2024	13.77
9	ADAMS KEVIN	8/29/2024	35	2024	14.52
10	ADAMS KEVIN	8/30/2024	35	2024	13.33
11	ADAMS KEVIN	Week 35 Total	35	2024	56.55
Sheet2

This data is located on sheet2

Time by week Master.xlsm
	B	C	D	E	F	G	H	I	J	K	L
1	EMPLOYEE NAME	YEAR - & WEEK -	2024	34	8/18/2024	8/19/2024	8/20/2024	8/21/2024	8/22/2024	8/23/2024	8/24/2024
2	Ansari Abdus-Sabur Q.
3	Argroe Ryant
4	Brantley Jonathan
Payroll Week Time

Cell Formulas
Range	Formula
F1	F1	=DATE(D1,1,1)+(E1-1)*7-WEEKDAY(DATE(D1,1,1),2)
G1:L1	G1	=F1+1

This data is located on Payroll Week Time

the VBA I am using did not error out and seemed to loop through but it did not populate my Payroll Week Time sheet.

I believe I may have the Range and Criteria reversed. but at 1 AM I'm cross-eyed
here is the VBA

Sub IndexMatchWithTwoCriteria()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Long, j As Long
    Dim criteria1 As String, criteria2 As String
    Dim result As Variant
    Dim searchRange1 As Range, searchRange2 As Range, indexRange As Range

    ' Set your worksheets (adjust the sheet names as needed)
    Set ws1 = ThisWorkbook.Sheets("Payroll Week Time")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")

    ' Define the ranges for criteria and index on Sheet2
    Set searchRange1 = ws2.Range("A:A") ' Criteria1 range (Column A)
    Set searchRange2 = ws2.Range("B:B") ' Criteria2 range (Column B)
    Set indexRange = ws2.Range("E:E") ' Index range (Column E)

    ' Loop through all rows in Sheet1 (B2:B90)
    For i = 2 To 90
        ' Get the criteria1 value from Sheet1
        criteria1 = ws1.Cells(i, "B").Value
       
        ' Loop through all columns in Sheet1 (F2:L2)
        For j = 6 To 12 ' Columns F to L
            ' Get the criteria2 value from Sheet1
            criteria2 = ws1.Cells(2, j).Value
           
            ' Perform the INDEX MATCH using WorksheetFunction.Match
            On Error Resume Next
            result = Application.WorksheetFunction.Index(indexRange, _
                        Application.WorksheetFunction.Match(1, _
                            (searchRange1 = criteria1) * (searchRange2 = criteria2), 0))
            On Error GoTo 0

            ' If a match is found, place the result in the corresponding cell in Sheet1
            If Not IsError(result) Then
                ws1.Cells(i, j).Value = result
            Else
                ws1.Cells(i, j).Value = "Not Found" ' Optional: to handle cases where no match is found
            End If
        Next j
    Next i

    MsgBox "Index Match operation completed.", vbInformation
End Sub

The code tags and all the other options are greyed out. sorry for the sloppy cut and paste on the code.

Also after I posted I realized that the week was wrong 34 vs 35 so the dates were off, I changed it and re-ran it and still no mas. thanks in advance for any help

 

[Alex Blakenburg]

Great to hear that you found it easy to modify.
If you want to do a similar thing as Trim to replace ";" you could add this line.

    arrSrc = Application.Substitute(arrSrc, ";", "")