Link to home
Start Free TrialLog in
Avatar of Luis Diaz
Luis DiazFlag for Colombia

asked on

Excel VBA: check if cells match with values from another column

Hello experts,

Following procedure allows me to to check change font to green if values, from a source column exist or not in another column.
Sub Is_In_Is_Not()

    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim RngToCompare As Range, RngToCompareWith As Range
    Dim colLetterSource As String, colLetterTarget As String
    Dim sRow As Long

    On Error Resume Next
    Set RngToCompare = Application.InputBox(Prompt:="Please activate the Source Sheet and select any cell in your source range (THEY SHOULD CONTAIN HEADERS)" & _
    vbNewLine & "In this range you will find the cells which are / or which are not in your range to compare", Type:=8)
    On Error GoTo 0
    If RngToCompare Is Nothing Then
        MsgBox "You didn't select any cell in the Source Range.", vbExclamation
        Exit Sub
    End If
    
    On Error GoTo Error_Routine

    Set wsSource = RngToCompare.Parent
    col = RngToCompare.Column
    If wsSource.Cells(1, col).Value <> "" Then
        sRow = 1
    Else
        sRow = wsSource.Cells(1, col).End(xlDown).Row
    End If
    lRw = wsSource.Cells(wsSource.Rows.Count, col).End(xlUp).Row
    Set RngToCompare = wsSource.Range(wsSource.Cells(sRow + 1, col), wsSource.Cells(lRw, col))

    On Error Resume Next
    Set RngToCompareWith = Application.InputBox(Prompt:="Please activate the target sheet and select any cell in the Range to compare with.", Type:=8)
    On Error GoTo 0
    If RngToCompareWith Is Nothing Then
        MsgBox "You didn't select any cell in the Range to compare with.", vbExclamation
        Exit Sub
    End If

    Set wsTarget = RngToCompareWith.Parent
    col = RngToCompareWith.Column
    If wsTarget.Cells(1, col).Value <> "" Then
        sRow = 1
    Else
        sRow = wsTarget.Cells(1, col).End(xlDown).Row
    End If

    lRw = wsTarget.Cells(wsTarget.Rows.Count, col).End(xlUp).Row
    Set RngToCompareWith = wsTarget.Range(wsTarget.Cells(sRow + 1, col), wsTarget.Cells(lRw, col))

    If MsgBox("You are going to compare the range " & RngToCompare.Address(0, 0) & " on " & wsSource.Name & " Sheet with the range " & RngToCompareWith.Address(0, 0) & " on " & wsTarget.Name & " Sheet." & vbNewLine & vbNewLine & _
              "Is that correct?", vbQuestion + vbYesNo, "Comfirm Please!") = vbNo Then

        MsgBox "You cancelled the range comparison.", vbExclamation, "Range Comparison Cancelled!"
        Exit Sub
    End If

    Application.ScreenUpdating = False

    For Each rCl In RngToCompare
        If Application.CountIf(RngToCompareWith, rCl.Value) > 0 Then
            Intersect(RngToCompare.Cells(1).CurrentRegion, rCl.EntireRow).Interior.ColorIndex = 4
        Else
            Intersect(RngToCompare.Cells(1).CurrentRegion, rCl.EntireRow).Interior.ColorIndex = 3
        End If
    Next rCl
    
    Exit Sub
Error_Routine:
    MsgBox Err.Description, vbExclamation, "Something went wrong!"

    Application.ScreenUpdating = True
    
End Sub

Open in new window


I was wondering if we can transpose the mechanism or see another approach to check if values from a source column match with any values of cells of another column. In If so change font color to green else to red.
User generated imageI attached dummy file.

If you have questions, please contact me.
DummySheetCompareColumnsWordByWord.xlsx
ASKER CERTIFIED SOLUTION
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Similar code, but without split
Sub Is_In_Is_Not()

    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim RngToCompare As Range, RngToCompareWith As Range
    Dim colLetterSource As String, colLetterTarget As String, spos As Integer
    Dim sRow As Long, col As Long, lRw As Long, rCl As Object, cwc As Object

    On Error Resume Next
GoTo rcmp
    Set RngToCompare = Application.InputBox(Prompt:="Please activate the Source Sheet and select any cell in your source range (THEY SHOULD CONTAIN HEADERS)" & _
    vbNewLine & "In this range you will find the cells which are / or which are not in your range to compare", Type:=8)
    On Error GoTo 0
    If RngToCompare Is Nothing Then
        MsgBox "You didn't select any cell in the Source Range.", vbExclamation
        Exit Sub
    End If
    
    On Error GoTo Error_Routine

    Set wsSource = RngToCompare.Parent
    col = RngToCompare.Column
    If wsSource.Cells(1, col).Value <> "" Then
        sRow = 1
    Else
        sRow = wsSource.Cells(1, col).End(xlDown).Row
    End If
    lRw = wsSource.Cells(wsSource.Rows.Count, col).End(xlUp).Row
    Set RngToCompare = wsSource.Range(wsSource.Cells(sRow + 1, col), wsSource.Cells(lRw, col))
' Skip dialogue for testing
'rcmp:
'    Set RngToCompare = ActiveSheet.Range("A2:A100")
'GoTo rcmd
    On Error Resume Next
    Set RngToCompareWith = Application.InputBox(Prompt:="Please activate the target sheet and select any cell in the Range to compare with.", Type:=8)
    On Error GoTo 0
    If RngToCompareWith Is Nothing Then
        MsgBox "You didn't select any cell in the Range to compare with.", vbExclamation
        Exit Sub
    End If

    Set wsTarget = RngToCompareWith.Parent
    col = RngToCompareWith.Column
    If wsTarget.Cells(1, col).Value <> "" Then
        sRow = 1
    Else
        sRow = wsTarget.Cells(1, col).End(xlDown).Row
    End If

    lRw = wsTarget.Cells(wsTarget.Rows.Count, col).End(xlUp).Row
    Set RngToCompareWith = wsTarget.Range(wsTarget.Cells(sRow + 1, col), wsTarget.Cells(lRw, col))

    If MsgBox("You are going to compare the range " & RngToCompare.Address(0, 0) & " on " & wsSource.Name & " Sheet with the range " & RngToCompareWith.Address(0, 0) & " on " & wsTarget.Name & " Sheet." & vbNewLine & vbNewLine & _
              "Is that correct?", vbQuestion + vbYesNo, "Confirm Please!") = vbNo Then

        MsgBox "You cancelled the range comparison.", vbExclamation, "Range Comparison Cancelled!"
        Exit Sub
    End If
' Skip dialogue for testing
'rcmd:
'Set RngToCompareWith = ActiveSheet.Range("C2:C3")
    Application.ScreenUpdating = False

    For Each cwc In RngToCompareWith
        cwc.Font.Color = RGB(255, 0, 0)
        For Each rCl In RngToCompare
'        If Application.CountIf(RngToCompareWith, rCl.Value) > 0 Then
'            Intersect(RngToCompare.Cells(1).CurrentRegion, rCl.EntireRow).Interior.ColorIndex = 4
'        Else
'            Intersect(RngToCompare.Cells(1).CurrentRegion, rCl.EntireRow).Interior.ColorIndex = 3
'        End If
        'Debug.Print rCl.Value
            spos = InStr(1, cwc, rCl, vbBinaryCompare)
            If spos > 0 Then cwc.Characters(Start:=spos, Length:=Len(rCl)).Font.Color = RGB(0, 255, 0)
            'Debug.Print rCl.Value
        Next rCl
    Next cwc
    
    
    
    
    
    Exit Sub
Error_Routine:
    MsgBox Err.Description, vbExclamation, "Something went wrong!"

    Application.ScreenUpdating = True
    
End Sub

Open in new window

Avatar of Luis Diaz

ASKER

@Subodh:

Your proposal works! Thank you for keeping the selection mode instead of forcing till the last cell as done by previous procedure.
For this specific case I realized that selection is the right mode!

Regards,
Luis.
@als315: I also tested your procedure but I got the following:

User generated image
Comment this line, it is for testing only