PDA

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