VBA get exact match from multiple entries on another sheet return true/false

Question

I have attempted to do this with index/match, vlookup, If statements, etc. I have searched for days (It it possible I don't know how to define what I am doing properly). VBA is new to me.

I have 2 sheets, the first Sheet (dataWs) is data to search titled Ach. Column A contains employee ID's on or about 3500 rows. Column B contains job duty codes. A single employee may have 1 or 20 job code entries, based on jobs they are qualified to perform. There are other columns for status and expire date, but they are not relevant.

Sheet 1

Sheet 2 (outputWs) contains ID numbers in column A (and a contact email in column B). I would like column C to find ID number in Sheet 1 column a, then in all entries for that ID, find job code 53 in sheet1 column B then reflect true or false if the employee ID is qualified to perform job duty 53 on Sheet 2 column C. If it is easier - putting just "53" in column c would also work.

Sheet 2

Here is a standard index match that works for ID lookup but does not consider the code 53 lookup:

Sub findJobQual ()

Dim outputWs As Worksheet, dataWs As Worksheet
Dim outputLastRow As Long, dataLastRow As Long, x As Long
Dim IndexRng As Range, MatchRng As Range

'Sources
Set outputWs = ThisWorkbook.Worksheets("Qualified")
Set dataWs = ThisWorkbook.Worksheets("Ach")

'count rows in tables
outputLastRow = outputWs.Range("A" & Rows.Count).End(xlUp).Row
dataLastRow = dataWs.Range("A" & Rows.Count).End(xlUp).Row

'Data column to return values from (Desired return)
Set IndexRng = dataWs.Range("B2:B" & dataLastRow)

'Data sent match to(Row)(Column)
Set MatchRng = IndexRng.Offset(0, -1)

On Error Resume Next

    For x = 2 To outputLastRow
                     'Send Cell
        outputWs.Range("A" & x).Value = Application.WorksheetFunction.Index(IndexRng, _
        Application.WorksheetFunction.Match(outputWs.Range("C" & x).Value, MatchRng, 0))
                                                          'Return Cell
    Next x

End Sub

I am aware that the above code is incomplete or may not be the method to do what I am trying to do. I am providing it as a boiler plate, as it will match ID numbers and output a value in other parts of my workbook. the above code may still need adjustment to work with the info I have provided. I know I need to add another argument but I am not sure how.

[Possibly helpful](https://stackoverflow.com/questions/42492758/vlookup-using-2-columns-to-reference-another). — BigBen, Jul 17 '23 at 18:55

score 1 · Accepted Answer · answered Jul 18 '23 at 09:13

A VBA Lookup (Dictionary of Dictionaries)

The keys of the dictionary hold the unique Ids while the items hold dictionaries whose keys hold the Achs.

Sub FlagJobQualifications()

    Const SRC_SHEET As String = "Qualified"
    Const SRC_ID_COLUMN As Long = 1
    Const SRC_ACH_COLUMN As Long = 2
    
    Const DST_SHEET As String = "Ach"
    Const DST_ID_COLUMN As Long = 1
    Const DST_ACH_COLUMN As Long = 3
    Const DST_ACH_LOOKUP_CELL As String = "C1"
    Const DST_ACH_PREFIX As String = "Code "
    Const DST_FLAG_YES = True
    Const DST_FLAG_NO = False
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
    
    Dim rg As Range, rCount As Long
    
    With sws.Range("A1").CurrentRegion
        rCount = .Rows.Count - 1
        If rCount = 0 Then
            MsgBox "No data in worksheet """ & SRC_SHEET & """.", vbCritical
            Exit Sub
        End If
        Set rg = .Resize(rCount).Offset(1)
    End With
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    'dict.CompareMode = vbTextCompare ' not necessary since only digits
    
    Dim rrg As Range, iStr As String, aStr As String
    
    For Each rrg In rg.Rows
        iStr = CStr(rrg.Cells(SRC_ID_COLUMN).Value)
        If Len(iStr) > 0 Then
            If Not dict.Exists(iStr) Then
                Set dict(iStr) = CreateObject("Scripting.Dictionary")
                'dict(iStr).CompareMode = vbTextCompare ' not necessary...
            End If
            aStr = CStr(rrg.Cells(SRC_ACH_COLUMN).Value)
            If Not dict(iStr).Exists(aStr) Then
                dict(iStr)(aStr) = Empty
            End If
        End If
    Next rrg
    
    If dict.Count = 0 Then
        MsgBox "Only blanks in worksheet """ & SRC_SHEET & """.", vbCritical
        Exit Sub
    End If
    
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
    
    With dws.Range("A1").CurrentRegion
        rCount = .Rows.Count - 1
        If rCount = 0 Then
            MsgBox "No data in worksheet """ & DST_SHEET & """.", vbCritical
            Exit Sub
        End If
        Set rg = .Resize(rCount).Offset(1)
    End With
        
    Dim daCell As Range: Set daCell = dws.Range(DST_ACH_LOOKUP_CELL)
    Dim daStr As String: daStr = CStr(daCell.Value)
        
    If InStr(1, daStr, DST_ACH_PREFIX, vbTextCompare) <> 1 Then
        MsgBox "The 'Ach' string """ & daStr & """ is invalid.", vbExclamation
        Exit Sub
    End If
        
    aStr = Right(daStr, Len(daStr) - Len(DST_ACH_PREFIX))
        
    Dim IsQualified As Boolean
        
    For Each rrg In rg.Rows
        iStr = CStr(rrg.Cells(DST_ID_COLUMN).Value)
        If dict.Exists(iStr) Then
            If dict(iStr).Exists(aStr) Then
                IsQualified = True
            End If
        End If
        If IsQualified Then
            rrg.Cells(DST_ACH_COLUMN).Value = DST_FLAG_YES
            IsQualified = False ' reset for the next iteration
        Else
            rrg.Cells(DST_ACH_COLUMN).Value = DST_FLAG_NO
        End If
    Next rrg
        
    MsgBox "Job qualifications flagged.", vbInformation

End Sub

Fantastic! works every time and it's so easy to change parameters by adjusting constant values. // Thank you! — user3705209, Jul 18 '23 at 21:04

score 0 · Answer 2 · answered Jul 17 '23 at 20:51

0

Maybe you can try a formula like below (to be entered in column c in the second sheet

=NOT(ISERROR(MATCH(A2&"|53",Ach!$A$2:$A$2500&"|"&Ach!$B$2:$B$2500,0)))

answered Jul 17 '23 at 20:51

rodro

131
2
6

Thank you for your reply. I did try running this in cell. It returns false for all ID numbers while a manual check shows 9 of the 11 ID's listed should return true. My reason for doing this as a VBA macro, rather than in cell, is that sheet 2 is replaced almost weekly so all cell based logic gets flushed. – user3705209 Jul 17 '23 at 21:13

score 0 · Answer 3 · answered Jul 18 '23 at 07:10

probably we have different layout in sheets, and my formula didn't work. Also your code works only if I exchange "C"<->"A" in the For loop, but it is not important.

If your code works for matching the cells so probably the simpliest measure to check it against 53 id just to add "=53" at the end to make a test. Of course you can use a variable and read it from another cell etc.

outputWs.Range("A" & x).Value = Application.WorksheetFunction.Index(IndexRng, _
        Application.WorksheetFunction.Match(outputWs.Range("C" & x).Value, MatchRng, 0)) = 53

VBA get exact match from multiple entries on another sheet return true/false

3 Answers3

A VBA Lookup (Dictionary of Dictionaries)