View Full Version : [SOLVED:] Macro to match cells in a range with those in another column.
simora
02-08-2021, 01:26 PM
I'm trying to match each cell in a range ( Column B) if Column A  is  NOT showing it as a Category heading;
 and if there's a  match in column E, Highlight it in col E in RED  and  copy the column E  cell location / address and put the location in Column D.
Attached is a worksheet with 2 matches to show  the desired result.
simora
02-09-2021, 05:12 PM
In case anyone can use a solution, This is what worked, except for  posting the column Heading.
Sub MatchNcolor()
  
Dim sh As Worksheet, lr As Long, fVal As Range, c As Range
Dim fv
Dim no
    Set sh = Sheets(1)    'Edit sheet name
    lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
        For Each c In sh.Range("E3:E21")    'Assumes header row
            Set fVal = sh.Range("B3:B" & lr).Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
                If Not fVal Is Nothing Then
                    fAdr = fVal.Address
                 
                    fv = fVal
                    Do
                    c.Interior.ColorIndex = 6
                    c.Font.ColorIndex = 3
                    fVal.Offset(0, 2) = c.Address
                    fVal.Value = c.Value
                    Set fVal = sh.Range("B3:B" & lr).FindNext(fVal)
                    Loop While fVal.Address <> fAdr
                End If
        Next
        ActiveSheet.Range("F2").Value = "No Matches"
        
        For Each no In Range("E3:E21")
            If Not no.Interior.ColorIndex = 6 Then
                no.Offset(0, 1).Value = no.Value
            End If
        Next
End Sub
jolivanes
02-10-2021, 12:46 PM
simora.
Another couple possibilities to play around with.
Sub Maybe_1()
Dim Area As Range, i As Long
    For Each Area In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Areas
        For i = 2 To Area.Cells.Count
            If WorksheetFunction.CountIf(Columns(5), Area.Cells(i)) <> 0 Then
                Area.Cells(i).Offset(, 2).Value = Columns(5).Find(Area.Cells(i).Value).Address(0, 0)
                Range(Area.Cells(i).Offset(, 2).Value).Font.Color = 255
            End If
        Next i
    Next Area
End Sub
Sub Maybe_2()
Dim c As Range
    For Each c In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(2)
        If Not c.Offset(, -1).Value = "Category" Then
            If WorksheetFunction.CountIf(Columns(5), c) <> 0 Then
                With Columns(5).Find(c)
                    c.Offset(, 2).Value = .Address(0, 0)
                    .Font.Color = 255
                End With
            End If
        End If
    Next c
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.