Check All Values in Range1 Against All Values in Range 2 for Exact Match-CodePudding

I am trying to compare all values in Range1 (cells in U:X of the active row), excluding blanks, against all values in Range2 (m, n), excluding blanks, and--if there's an exact match between the ranges--change the color of column Y in the active row, else do not change the color.

Example:

Range1 contains Dog, Cat, Bird, [blank cell], and Range2 includes Dog, Cat, Bird, [multiple blank cells] = MATCH

Range1 contains Dog, Cat, [blank cell], [blank cell] and Range2 includes Dog, Cat, Bird, [multiple blank cells] = NO MATCH

Here's what I have so far, but yColumn is not changing color when there's a complete match. Do I need another loop?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cVal As String
    Dim tRow, lRow As Long
    Dim pID As String
    Dim yColumn As Integer
    cVal = Sheet1.Cells(Target.Row, Target.Column).Value
    tRow = Target.Row
    yColumn = 25
    lRow = Sheet4.Range("A1200").End(xlUp).Row
    pID = Sheet1.Range("A" & tRow).Value
    
' Check for ALL Cells Match
        If Not Intersect(Target, Range("U2:X1500")) Is Nothing Then
            Sheet1.Cells(tRow, yColumn).Interior.Color = xlNone
                For m = 2 To lRow
                    If Sheet4.Range("A" & m).Value = pID Then
                For n = 11 To 28
                        If Sheet4.Cells(m, n).Value = cVal And Sheet4.Cells(m, n).Value <> "" And Target(Range("U2:X1500")) = Sheet4.Cells(m, n).Value Then
                        Sheet1.Cells(tRow, yColumn).Interior.Color = 914271
                        Exit Sub
                        End If
                Next n
                    End If
                Next m
        End If
End Sub

CodePudding user response：

Please, test the next way:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lRow As Long, pID As String, yColumn As Long, m As Long
    Dim arrUX, arrKAB, El1, El2, boolFound As Boolean
    yColumn = 25
    lRow = Sheet4.Range("A" & rows.Count).End(xlUp).row
    pID = Me.Range("A" & Target.row).Value
    
        If Not Intersect(Target, Range("U2:X1500")) Is Nothing Then
            Target.Interior.color = xlNone
            For m = 2 To Target.row
                If Sheet4.Range("A" & m).Value = pID Then
                    arrUX = Me.Range(Me.cells(Target.row, "U"), Me.cells(Target.row, "X")).Value
                    arrKAB = Sheet4.Range(arrKAB.cells(m, "K"), Sheet4.cells(m, "AB")).Value
                    For Each El1 In arrUX
                        boolFound = False
                        For Each El2 In arrKAB
                            If El1 <> "" Then
                                If El1 = El2 Then boolFound = True: Exit For
                            End If
                        Next
                        If Not boolFound Then Exit Sub 'if one element of the first array is not found, existing
                    Next El1
                    If boolFound Then
                        Application.EnableEvents = False
                         Target.Interior.color = 914271
                        Application.EnableEvents = True
                    Exit Sub 'since only one occurrence should exist...
                End If
            Next m
        End If
End Sub

CodePudding user response：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim v, lr As Long, tRow As Long
    Dim s1 As String, s2 As String
    Dim pID As String, c As Range
    
    If Intersect(Target, Range("U:X")) Is Nothing Then
         Exit Sub
    End If
    
    tRow = Target.Row
    For Each c In Sheet1.Range("U1:X1").Offset(tRow - 1)
        If Len(c) > 0 Then
            s1 = s1 & Trim(c) & "|"
        End If
    Next

    ' find on sheet 4
    pID = Sheet1.Range("A" & tRow).Value
    With Sheet4
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        v = Application.Match(pID, .Range("A1:A" & lr), 0)
        If IsError(v) Then Exit Sub
        
        For Each c In .Range("K1:AB1").Offset(v - 1)
            If Len(c) > 0 Then
                 s2 = s2 & Trim(c) & "|"
            End If
        Next
        
        If s1 = s2 Then
            Sheet1.Cells(tRow, 25).Interior.Color = 914271
        Else
            Sheet1.Cells(tRow, 25).Interior.Color = xlNone
        End If
       
    End With
    
End Sub