CODEWITHSUNDEEP
excelvba
Lio Djo
Lio Djo

Reputation: 129

How to highlight matched values from two different ranges and worksheets?

I would like to highlight matching values in two different ranges and worksheets using VBA.

Worksheet #1 is named "OVR" with the range S2:V100 (where the highlighted values should show).
Worksheet #2 is named "LS" with the range A2:A101 containing a list of names.

My goal is to highlight all the cells in the range S2:V100 (from the "OVR" worksheet) that have a match with one of the cells in the range A2:A101 (from the "LS" worksheet).

I would like to integrate it to existing VBA for this file.

Sub FindReference()
    LR1 = Worksheets("LS").Cells(Rows.Count, "A").End(xlUp).Row
    LR2 = Worksheets("OVR").Cells(Rows.Count, "A").End(xlUp).Row
    Set rng1 = Worksheets("LS").Range("A2:A101" & LR1)
    Set rng2 = Worksheets("OVR").Range("S2:V100" & LR1)
    For Each rCell In rng1
        rCell.Interior.ColorIndex = xlNone
        rCell.Validation.Delete
        result = WorksheetFunction.CountIf(rng2, rCell)
        If result > 0 Then rCell.Interior.Color = vbGreen
    Next
End Sub

Upvotes: 2

Views: 134

Answers (1)

VBasic2008
VBasic2008

Reputation: 54777

Color Matching Cells

Option Explicit

Sub FindReference()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim lRow As Long
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets("LS")
    lRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    Dim srg As Range: Set srg = sws.Range("A2:A" & lRow)
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets("OVR")
    lRow = dws.Cells(dws.Rows.Count, "A").End(xlUp).Row
    Dim drg As Range: Set drg = dws.Range("S2:V" & lRow)
    
    ' Combine matching cells.
    
    Dim durg As Range
    Dim dCell As Range
    Dim dValue As Variant
    
    For Each dCell In drg.Cells
        dValue = dCell.Value
        If Not IsError(dValue) Then
            If Len(dValue) > 0 Then
                If IsNumeric(Application.Match(dValue, srg, 0)) Then
                    If durg Is Nothing Then
                        Set durg = dCell
                    Else
                        Set durg = Union(durg, dCell)
                    End If
                End If
            End If
        End If
    Next dCell
    
    ' Color matching cells.
    
    drg.Interior.ColorIndex = xlNone
    drg.Validation.Delete
    
    If Not durg Is Nothing Then
        durg.Interior.Color = vbGreen
    End If
    
    ' Inform.
    
    MsgBox "Data highlighted.", vbInformation

End Sub

Upvotes: 2

Related Questions