Search code examples
arraysexcelvbamatchcriteria

Excel Index Match - Pairing a set of random values corresponding to a range


In the following data, I would like to use columns L and M in order to pair with matches between A,B and C,D respectively.

Sample Picture

To be more precise, I would like Serial Number A: 10 - SUV to match Serial Number: B 10 - Car. If any of these combinations do not match, I should be getting a red flag. For instance, Serial Number A: 40, cannot take the value "Sedan." It would have to be either "Road Bike" or "Mountain Bike" according to the pair values in columns L and M, respectively.

I was thinking a double match would work, however, I am not sure how to tackle this issue.

Thank you in advance!


Solution

  • I had a chance to debug the code example I wrote, so here is the working product.

    I think what you need is to build an array of suitable responses for each selection, using something like:

    Function GetKeys() As Variant
        'This function will obtain an array of suitable response keys that can be used to then check the values.
        Dim TmpArr As Variant
        Dim Sht As Worksheet
        Set Sht = Worksheets("[SheetName]") 'Replace [SheetName] with your actual sheer name.
        TmpArr = Sht.Range("L2:M" & Sht.Range("L" & Sht.Rows.Count).End(xlUp).Row).Value
        TmpArr = Application.WorksheetFunction.Transpose(TmpArr)
        Dim Arr() As String
        ReDim Arr(1 To 2, 1 To 1) As String
        Dim NoKeys As Integer, X As Integer, Y As Integer
        'This will fill the first dimension of the array with the unique values from Column M
        Arr(1, 1) = LCase(CStr(TmpArr(2, 1)))
        For X = 2 To UBound(TmpArr, 2)
            For Y = 1 To UBound(Arr, 2)
                If LCase(CStr(TmpArr(2, X))) = Arr(1, Y) Then GoTo ExistsAlready
            Next Y
            ReDim Preserve Arr(1 To 2, 1 To (UBound(Arr, 2) + 1))
            Arr(1, UBound(Arr, 2)) = LCase(CStr(TmpArr(2, X)))
    ExistsAlready:
        Next X
        'This now fills the second dimension of the array with a comma separated list of suitable values from Column L
        For X = 1 To UBound(TmpArr, 2)
            For Y = 1 To UBound(Arr, 2)
                If LCase(CStr(TmpArr(2, X))) = Arr(1, Y) Then
                        If Arr(2, Y) = "" Then
                                Arr(2, Y) = LCase(CStr(TmpArr(1, X)))
                            Else
                                Arr(2, Y) = Arr(2, Y) & ", " & LCase(TmpArr(1, X))
                        End If
                        Exit For
                End If
            Next Y
        Next X
        GetKeys = Arr
    End Function
    

    Then once you have that, you could check the list of values against that array, using something like:

    Sub CheckValues()
        Dim Sht As Worksheet
        Dim Keys As Variant
        'This calls the above function to obtain the list of suitable keys
        Keys = GetKeys
        Dim Set1 As Variant, Set2 As Variant
        Set Sht = Worksheets("[SheetName]")
        Set1 = Sht.Range("A2:B" & Sht.Range("A" & Sht.Rows.Count).End(xlUp).Row).Value
        Set2 = Sht.Range("C2:D" & Sht.Range("C" & Sht.Rows.Count).End(xlUp).Row).Value
        Set1 = Application.WorksheetFunction.Transpose(Set1)
        Set2 = Application.WorksheetFunction.Transpose(Set2)
        Dim X As Integer, Y As Integer, Z As Integer
        'This starts by looping through each row of data in Columns C:D and finds the corresponding key value from Column M
        For X = 1 To UBound(Set2, 2)
            For Y = 1 To UBound(Keys, 2)
                If LCase(CStr(Set2(2, X))) = CStr(Keys(1, Y)) Then
                        'Having Found the key from Column C:D, it now finds the value in Column A that matches C
                        For Z = 1 To UBound(Set1, 2)
                            'This checks whether the value in B is one of the suitable values from Column L and colours the cells if not
                            If Set2(1, X) = Set1(1, Z) Then
                                    If Keys(2, Y) Like "*" & LCase(CStr(Set1(2, Z))) & "*" Then
                                            GoTo Found_It
                                        Else
                                            Sht.Range("A" & (Z + 1) & ":B" & (Z + 1)).Interior.ColorIndex = 46
                                            Sht.Range("C" & (X + 1) & ":D" & (X + 1)).Interior.ColorIndex = 46
                                            GoTo Found_It
                                     End If
                            End If
                        Next Z
                End If
            Next Y
    Found_It:
        Next X
    End Sub