I Have Range1(S4:W8) and Range2(J4:N18).

I want to create a Macro that will check if any cells between the two ranges are equal to each other, and if so, highlight. Depending on the scenario, Range2 may have few, or many blank cells.

Below is My attempt. "*****" is a placeholder for me because I don't know what to put there.

Dim R1 As Range
Set R1 = Range("S4:W8")

Dim R2 As Range
Set R2 = Range("J4:N18")

For Each Cell In R1
        If Cell.Value ***** Then
            Cell.Interior.ColorIndex = 6
            
        End If
    Next


End Sub

CodePudding user response：

There's a lot of ways to do this, but here's a simple method that might help you with understanding loops and ranges. I presume you don't want to use conditional formatting for something like this.

I changed up your variables a little for clarity, and added an exit for since once you match a color no need to keep searching.

Sub doTHis()
Dim aRng As Range, gRng As Range, aCell As Range, gCell As Range

'probably should scope the sheet too

Set aRng = Range("S4:W8")
Set gRng = Range("J4:N18")

For Each aCell In aRng.Cells
        For Each gCell In gRng.Cells
            If gCell.Value = aCell.Value Then
                aCell.Interior.ColorIndex = 6
                Exit For ' no need to keep searching
            End If
        Next gCell
Next aCell

End Sub

CodePudding user response：

Please, test the next way. It should be very fast for large ranges, using arrays, placing the cells to be colored in a Union range and color them at the code end. It also skips the empty cells to be compared:

Sub testMatchRngValues()
Dim R1 As Range, R2 As Range, rngCol As Range, arr1, arr2, i As Long, j As Long, i1 As Long, j1 As Long

Set R1 = Range("S4:W8"):  arr1 = R1.Value  'place the range in an array for faster interation
Set R2 = Range("J4:N18"): arr2 = R2.Value  'place the range in an array for faster interation

For i = 1 To UBound(arr1)
    For j = 1 To UBound(arr1, 2)
        For i1 = 1 To UBound(arr2)
            For j1 = 1 To UBound(arr2, 2)
                If arr1(i, j) = arr2(i1, j1) And arr1(i, j) <> "" And arr2(i1, j1) <> "" Then
                    If rngCol Is Nothing Then
                        Set rngCol = R1.cells(i, j)
                    Else
                        Set rngCol = Union(rngCol, R1.cells(i, j))
                    End If
                End If
            Next j1
        Next i1
    Next j
Next i
If Not rngCol Is Nothing Then rngCol.Interior.ColorIndex = 6
End Sub

CodePudding user response：

If you want simplicity over performance, you could use this code:

Sub findInRange()

    Dim R1 As Range
    Set R1 = Range("S4:W8")

    Dim R2 As Range
    Set R2 = Range("J4:N18")

    Dim fnd As Range

    ' search R2 for cell in R1
    For Each cell In R1

        Set fnd = R2.Find(cell.Value, lookat:=xlWhole)
        
        If Not fnd Is Nothing Then
            ' colour matched cells
            cell.Interior.ColorIndex = 6
        Else
            ' reset colour in unmatched cells
            cell.Interior.ColorIndex = 0
        End If
    Next

End Sub

CodePudding user response：

Highlight Column Matches

• This will highlight matches per column i.e. each range has the same number of columns, so it will find matches of the cells in columns of the source range in cells in the respective columns of the destination range and highlight them in yellow.

Option Explicit

Sub HighlightColumnMatches()
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim srg As Range: Set srg = ws.Range("J4:N18")
    
    Dim drg As Range: Set drg = ws.Range("S4:W8")
    Dim drCount As Long: drCount = drg.Rows.Count
    Dim dData As Variant: dData = drg.Value
    
    Dim scrg As Range
    Dim sIndex As Variant
    Dim durg As Range
    Dim dr As Long
    Dim dc As Long
    
    For dc = 1 To drg.Columns.Count
        Set scrg = srg.Columns(dc)
        For dr = 1 To drCount
            sIndex = Application.Match(dData(dr, dc), scrg, 0)
            If IsNumeric(sIndex) Then
                If durg Is Nothing Then
                    Set durg = drg.Cells(dr, dc)
                Else
                    Set durg = Union(durg, drg.Cells(dr, dc))
                End If
            End If
        Next dr
    Next dc
                
    If Not durg Is Nothing Then
        drg.Interior.Color = xlNone
        durg.Interior.Color = vbYellow
    End If

    MsgBox "Matches highlighted.", vbInformation

End Sub