Match and color cells if same value cell in other sheet detected

[Dempix]

Hello everyone,

I'm trying to make macros which will find and color particular cells which have the same value as cells in other sheet.

I have two different sheets - 1st one smaller (~500 rows with several columns) and 2nd sheet with ~60000 rows and more columns. I need to make a macros that will check if the cell value (ten digit number) in the 1st sheet is mentioned in 2nd sheet - if yes, the cell in the 1st sheet should be filled in red.

In the first sheet column with those ten digit numbers is C. In the 2nd sheet - B.

This macros should be triggered with some keyboard combination.

I tried using conditional formatting, but it doesn't work for me... Maybe you could help me?

Thanks!

[The_Greg]

Hello Dempix.

Sub Dempix()
Application.ScreenUpdating = False

Sheets("Sheet2").Activate   'RENAME SHEET 2
Set Rng = Range(Cells(1, 2), Cells(1, 2).End(xlDown))
Sheets("Sheet1").Activate   'RENAME SHEET 1
For Each cell In Range(Cells(1, 3), Cells(1, 3).End(xlDown))
Set Fcell = Rng.Find(What:=cell.Value, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Fcell Is Nothing Then
cell.Interior.Color = 255
Else
'SKIP
End If
Next cell
    
MsgBox "All done!"
Application.ScreenUpdating = True
End Sub

NOTE! Rename sheets in code. In excel go to developer tab, click on "Macros" select this macro and click on "Options", select prefered keyboard shortcut to run the macro.

[Dempix]

Many many thanks The_Greg! It works perfectly!

Is it possible to adjust the macros that it would work this Sheet 2 placed in different location/file:
For example, Sheet 2 is stored at S:\Folder\file.xlsx sheet name
?

[The_Greg]

Hello Dempix, here is the modified code.

Sub Dempix()
Application.ScreenUpdating = False

Dim MainWB As String
MainWB = ActiveWorkbook.Name

Workbooks.Open ("S:\Folder\file.xlsx")  'RENAME FILE HERE

Sheets("Sheet2").Activate   'RENAME SHEET 2
Set Rng = Range(Cells(1, 2), Cells(1, 2).End(xlDown))
Workbooks(MainWB).Sheets("Sheet1").Activate   'RENAME SHEET 1

For Each cell In Range(Cells(1, 3), Cells(1, 3).End(xlDown))
    Set Fcell = Rng.Find(What:=cell.Value, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not Fcell Is Nothing Then
        cell.Interior.Color = 255
    Else
        'SKIP
    End If
Next cell
    
Workbooks("file.xlsx").Close    'RENAME FILE HERE OR REMOVE THIS LINE
    
MsgBox "All done!"
Application.ScreenUpdating = True
End Sub