VBA to complete Index/Match with 2 criteria

Drrellik

Drrellik

Well-known Member
Joined
Apr 29, 2013
Messages
844
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
Time by week Master.xlsm
ABCDE
1ADAMS ANTONIO8/26/202435202413.5
2ADAMS ANTONIO8/27/202435202414.93
3ADAMS ANTONIO8/28/202435202413.77
4ADAMS ANTONIO8/29/202435202414.52
5ADAMS ANTONIO8/30/202435202413.33
6ADAMS ANTONIOWeek 35 Total35202470.05
7ADAMS KEVIN8/27/202435202414.93
8ADAMS KEVIN8/28/202435202413.77
9ADAMS KEVIN8/29/202435202414.52
10ADAMS KEVIN8/30/202435202413.33
11ADAMS KEVINWeek 35 Total35202456.55
Sheet2


This data is located on sheet2

Time by week Master.xlsm
BCDEFGHIJKL
1EMPLOYEE NAMEYEAR - & WEEK -2024348/18/20248/19/20248/20/20248/21/20248/22/20248/23/20248/24/2024
2Ansari Abdus-Sabur Q.
3Argroe Ryant
4Brantley Jonathan
Payroll Week Time
Cell Formulas
RangeFormula
F1F1=DATE(D1,1,1)+(E1-1)*7-WEEKDAY(DATE(D1,1,1),2)
G1:L1G1=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

VBA Code: 
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
 
Last edited by a moderator:

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
I don't think you can stack/combine Application.WorksheetFunction like that. I find it far easier for complex formulas like that to build a string for the formula and then evaluate the formula to get the result. You should also restrict the search and index ranges to the extent of the data rather than the entire column or it will be very slow.

VBA Code: 
Sub IndexMatchWithTwoCriteria()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Long, j As Long, lastRow As Long
    Dim criteria1 As String, criteria2 As String
    Dim result As Variant
    Dim searchRange1 As String, searchRange2 As String, indexRange As String
    Dim strFormula As String
    
    ' Set your worksheets (adjust the sheet names as needed)
    Set ws1 = ThisWorkbook.Sheets("Payroll Week Time")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' Get last row of  Sheet2
    lastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
    ' Define the ranges for criteria and index on Sheet2
    searchRange1 = "Sheet2!$A$1:$A$" & lastRow ' Criteria1 range (Column A)
    searchRange2 = "Sheet2!$B$1:$B$" & lastRow ' Criteria2 range (Column B)
    indexRange = "Sheet2!$A$1:$E$" & lastRow ' Index range (Columns A:E)
    ' Get last row of  payroll sheet
    lastRow = ws1.Range("B" & Rows.Count).End(xlUp).Row
    '
    ' Switch off calculations and screen updating for speed.
    '
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Loop through all rows in Sheet1 (B2:B90)
    For i = 2 To lastRow
        ' Get the criteria1 value from Sheet1
        criteria1 = ws1.Cells(i, "B").Address
        
        ' 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(1, j).Address
            
            ' Build an INDEX/MATCH formula as a string and evaluate it
            strFormula = "INDEX(" & indexRange & ",MATCH(1,(" & searchRange1 & "=" & criteria1 & _
                            ") * (" & searchRange2 & "=" & criteria2 & "),0),5)"
            
            result = Evaluate(strFormula)
            
            ' 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
    '
    ' Switch on calculations and screen updating.
    '
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "Index Match operation completed.", vbInformation
    End Sub
 
Upvote 0
If you are going to use a formula anyway why not just use that rather than VBA ?
Murray @myall_blues has given you a working version using Index-Match.

If you are going to use code ditching index match and using a dictionary might be faster.

VBA Code: 
Sub GetAndTransposeTimes()

    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim lastRowSrc As Long, lastRowDest As Long
    Dim rngSrc As Range, rngDest As Range, rngOut As Range
    Dim arrSrc As Variant, arrDest As Variant, arrOut As Variant
    Dim i As Long, j As Long
    Dim dictSrc As Object, dictKey As String
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set shtDest = ThisWorkbook.Sheets("Payroll Week Time")
    Set shtSrc = ThisWorkbook.Sheets("Sheet2")

    With shtSrc
        lastRowSrc = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngSrc = .Range("A1:E" & lastRowSrc)
        arrSrc = rngSrc.Value2
    End With
    
    With shtDest
        lastRowDest = .Range("B" & Rows.Count).End(xlUp).Row
        Set rngDest = .Range("B1:L" & lastRowDest)
        Set rngOut = .Range("F2:L" & lastRowDest)
        arrDest = rngDest.Value2
        ReDim arrOut(1 To UBound(arrDest) - 1, 1 To rngOut.Columns.Count)
    End With
    
    Set dictSrc = CreateObject("Scripting.dictionary")
    dictSrc.CompareMode = vbTextCompare
    
    ' Load source range into Dictionary using name and date as the key
    For i = 1 To UBound(arrSrc)
        If InStr(1, arrSrc(i, 2), "Total", vbTextCompare) = 0 Then
            dictKey = arrSrc(i, 1) & "|" & arrSrc(i, 2)
            If Not dictSrc.exists(dictKey) Then
                dictSrc(dictKey) = arrSrc(i, 5)
            End If
        End If
    Next i
    
    For i = 2 To UBound(arrDest)
        For j = 5 To 11
            dictKey = arrDest(i, 1) & "|" & arrDest(1, j)
            If dictSrc.exists(dictKey) Then
                arrOut(i - 1, j - 4) = dictSrc(dictKey)
            Else
                arrOut(i - 1, j - 4) = "Not Found"
            End If
        Next j
    Next i
    
    rngOut.Value2 = arrOut
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "Operation completed.", vbInformation

End Sub
 
Upvote 0
Drrellik said:
The code tags and all the other options are greyed out.
Click to expand...
That would usually mean that you have clicked 'Preview' or 'Toggle BB code'.

1725283475504.png


Click it again to get the code tags etc back.
I have added the code tags for you this time. :)
 
Upvote 0
Alex Blakenburg said:
If you are going to use a formula anyway why not just use that rather than VBA ?
Murray @myall_blues has given you a working version using Index-Match.

If you are going to use code ditching index match and using a dictionary might be faster.
Click to expand...

Alex,

There are currently 87 rows with employee names and with 7 days of the week to Index/Match as an Array it chokes down my laptop it worked but it was very slow I thought VBA would be faster
and if someone changes a cell after I have the Values it wont try to re-run all the Arrays.

I will try the Array again. and the VBA you supplied returned Not Found in all the cells
 
Upvote 0
myall_blues said:
I don't think you can stack/combine Application.WorksheetFunction like that. I find it far easier for complex formulas like that to build a string for the formula and then evaluate the formula to get the result. You should also restrict the search and index ranges to the extent of the data rather than the entire column or it will be very slow.
Click to expand...

Myall Blues,

Your code returned Not Found in all the cells as well
 
Upvote 0
I can post more of my data to include at least the first few names so you can check for your self incase I am doing something wrong.

Time by week Master.xlsm
ABCDEFGHIJKLMN
1EEIDEMPLOYEE NAMEYEAR - & WEEK -2024358/25/20248/26/20248/27/20248/28/20248/29/20248/30/20248/31/2024Week 35 TotalsLocation
25171Ansari Abdus-Sabur Q.Not FoundNot FoundNot FoundNot FoundNot FoundNot FoundNot FoundColumbia
35374Argroe RyantNot FoundNot FoundNot FoundNot FoundNot FoundNot FoundNot FoundColumbia
45339Brantley JonathanNot FoundNot FoundNot FoundNot FoundNot FoundNot FoundNot FoundColumbia
Payroll Week Time
Cell Formulas
RangeFormula
F1F1=DATE(D1,1,1)+(E1-1)*7-WEEKDAY(DATE(D1,1,1),2)
G1:L1G1=F1+1
M1M1="Week "&E1&" Totals"


Time by week Master.xlsm
ABCDE
41ANSARI ABDUS-SABUR Q.8/26/20243520246.68
42ANSARI ABDUS-SABUR Q.8/27/202435202413.5
43ANSARI ABDUS-SABUR Q.8/28/20243520248.92
44ANSARI ABDUS-SABUR Q.8/29/20243520249.03
45ANSARI ABDUS-SABUR Q.8/30/202435202410.2
46ANSARI ABDUS-SABUR Q.Week 35 Total35202448.33
47ARGROE RYANT8/26/20243520248.67
48ARGROE RYANT8/27/20243520247.3
49ARGROE RYANT8/28/20243520248.83
50ARGROE RYANT8/29/20243520246.9
51ARGROE RYANT8/30/20243520241.13
52ARGROE RYANTWeek 35 Total35202432.83
53ASBURY CHARLES8/26/20243520245.78
54ASBURY CHARLES8/27/202435202411.33
55ASBURY CHARLES8/28/20243520247.93
56ASBURY CHARLES8/29/202435202411.3
57ASBURY CHARLES8/30/202435202411.17
58ASBURY CHARLESWeek 35 Total35202447.52
59ASHLEY EDDIE8/26/20243520246.77
60ASHLEY EDDIE8/27/20243520247.42
61ASHLEY EDDIE8/28/20243520248.05
62ASHLEY EDDIE8/29/20243520246.13
63ASHLEY EDDIE8/30/20243520242.93
64ASHLEY EDDIEWeek 35 Total35202431.3
65BAKER SR CHANDLER8/26/202435202412.6
66BAKER SR CHANDLER8/27/202435202410.98
67BAKER SR CHANDLER8/28/202435202411.58
68BAKER SR CHANDLER8/29/202435202413.15
69BAKER SR CHANDLER8/30/202435202412.1
70BAKER SR CHANDLERWeek 35 Total35202460.42
71BALFOUR BERTRAM8/26/202435202410.5
72BALFOUR BERTRAM8/27/202435202410.13
73BALFOUR BERTRAM8/28/20243520249.85
74BALFOUR BERTRAM8/29/202435202410
75BALFOUR BERTRAM8/30/20243520246.68
76BALFOUR BERTRAMWeek 35 Total35202447.17
77BANKS KAREEM D8/26/20243520249.65
78BANKS KAREEM D8/27/20243520248.1
79BANKS KAREEM D8/28/202435202412.02
80BANKS KAREEM D8/29/202435202410.43
81BANKS KAREEM D8/30/20243520245.8
82BANKS KAREEM DWeek 35 Total35202446
83BARNES SHARETTA L.8/26/20243520249
84BARNES SHARETTA L.8/27/20243520249.87
85BARNES SHARETTA L.8/28/202435202411.98
86BARNES SHARETTA L.8/29/20243520245.13
87BARNES SHARETTA L.Week 35 Total35202435.98
88BLANKENSHIP MICHAEL8/27/20243520248.57
89BLANKENSHIP MICHAEL8/28/20243520249.15
90BLANKENSHIP MICHAEL8/29/20243520246.5
91BLANKENSHIP MICHAEL8/30/20243520246.78
92BLANKENSHIP MICHAELWeek 35 Total35202431
93BONNER GABRIEL D8/26/20243520249.03
94BONNER GABRIEL D8/27/202435202415.45
95BONNER GABRIEL D8/28/20243520247.58
96BONNER GABRIEL D8/29/202435202413.42
97BONNER GABRIEL DWeek 35 Total35202445.48
98BOULDIN MARK A8/27/20243520248.6
99BOULDIN MARK A8/29/202435202411.67
100BOULDIN MARK A8/30/20243520248.32
101BOULDIN MARK AWeek 35 Total35202428.58
102BOWENS JALENE8/26/20243520249.5
103BOWENS JALENE8/27/202435202410
104BOWENS JALENE8/28/202435202410
105BOWENS JALENE8/29/202435202410
106BOWENS JALENE8/30/20243520241
107BOWENS JALENEWeek 35 Total35202440.5
108BOYD BAILEY8/29/202435202412
109BOYD BAILEY8/30/20243520248.5
110BOYD BAILEYWeek 35 Total35202420.5
111BOZEMAN JR MICHAEL8/26/20243520248.47
112BOZEMAN JR MICHAEL8/27/20243520245.62
113BOZEMAN JR MICHAEL8/28/20243520240.5
114BOZEMAN JR MICHAEL8/29/20243520246.33
115BOZEMAN JR MICHAELWeek 35 Total35202420.92
116BRADLEY DONTREL8/26/202435202413
117BRADLEY DONTREL8/27/202435202414
118BRADLEY DONTREL8/28/202435202413.57
119BRADLEY DONTREL8/29/202435202410
120BRADLEY DONTREL8/30/20243520245.5
121BRADLEY DONTRELWeek 35 Total35202456.07
122BRANTLEY JONATHAN8/26/202435202420.98
123BRANTLEY JONATHAN8/27/202435202413.02
124BRANTLEY JONATHAN8/28/202435202411.35
125BRANTLEY JONATHAN8/29/202435202412.23
126BRANTLEY JONATHAN8/30/202435202411.2
127BRANTLEY JONATHANWeek 35 Total35202468.78
Sheet2
 
Upvote 0
In the ideal world both data sets would have the EEID to join them on. The issue seems to be that Sheet2 has 2 spaces between the last name and first name.
If you add the line in blue to the code I gave you it should work.

Rich (BB code): 
    ' Load source range into Dictionary using name and date as the key
    arrSrc = Application.Trim(arrSrc)
    For i = 1 To UBound(arrSrc)
        If InStr(1, arrSrc(i, 2), "Total", vbTextCompare) = 0 Then
            dictKey = arrSrc(i, 1) & "|" & arrSrc(i, 2)
            If Not dictSrc.exists(dictKey) Then
                dictSrc(dictKey) = arrSrc(i, 5)
            End If
        End If
    Next i
 
Upvote 0
Solution
Alex Blakenburg said:
VBA Code: 
 ' Loop through each cell in the range
        For Each cell In rng
            If Not IsEmpty(cell.Value) Then
                ' Replace " and = with an empty string
                cell.Value = Replace(cell.Value, """", "")
                cell.Value = Replace(cell.Value, "=", "")
                cell.Value = Replace(cell.Value, ";", " ")
            End If
        Next cell
In the ideal world both data sets would have the EEID to join them on. The issue seems to be that Sheet2 has 2 spaces between the last name and first name.
If you add the line in blue to the code I gave you it should work.

Rich (BB code): 
    ' Load source range into Dictionary using name and date as the key
    arrSrc = Application.Trim(arrSrc)
    For i = 1 To UBound(arrSrc)
        If InStr(1, arrSrc(i, 2), "Total", vbTextCompare) = 0 Then
            dictKey = arrSrc(i, 1) & "|" & arrSrc(i, 2)
            If Not dictSrc.exists(dictKey) Then
                dictSrc(dictKey) = arrSrc(i, 5)
            End If
        End If
    Next i
Click to expand...
Adding that line worked, it also told me how to go back to the code in the step before where I removed all the extra syntax like ; " & = from the name and date range and I was actually adding that extra space when I removed the ; so I changed it to ";", "" and that fixed it as well, I also left in your arrsrc = application.trim line just in case.

I also change the "Not Found" to just "" as I am just looking for Hours worked during that week

Thank you all for helping

Doc
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
Finding the differences then copy and paste code to a new sheet
Replies
1
Views
631
myall_blues
myall_blues
G
  • Solved
Combine input box (multiple criteria)
Replies
4
Views
107
gomes123
G
C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
187
NdNoviceHlp
NdNoviceHlp
B
  • Question Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
565
B-radK
B
T
  • Question Question
VBA compare values on different sheets.
Replies
5
Views
611
rlv01
R

Forum statistics

Threads
1,223,929
Messages
6,175,460
Members
452,644
Latest member
gjcase

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