Cell look up from one column and highlight cell another column

Hi.

I am attaching two files.

File Book1 has values in Column A.

These values are to be looked up in File Nifty All Column A and Highlight that cell in green color.

Please if possible.

Great work.

Its working absolutely fine.

You are wonderful Roy

Quote from royUK

Open both WorkBooks.

Click the button in Book1

Hi Roy,

This VBA highlights only one cell of particular name.

Actually there maybe more than 1 cells matching, so can it highlight all the matching cell of that particular name.

Hi Roy,

Thanks for your response.

It's not working.

Just highlighting one cell and hangs up.

Quote from royUK

Check this

Code

Sub Findmatches()
    Dim rCl As Range, rFnd As Range, rSrc As Range
    
    Dim FirstFnd As String
    Set rSrc = Workbooks("Nifty All.xlsx").Sheets(1).Range("A1").CurrentRegion
    For Each rCl In ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion.Columns(1).Cells
        Set rFnd = rSrc.Find(rCl.Value)
        If Not rFnd Is Nothing Then
            FirstFnd = rFnd.Address
            Do
                rFnd.Interior.Color = vbGreen
                Set rCl = rSrc.FindNext(rCl)
            Loop While Not rCl Is Nothing
        End If
    Next rCl
End Sub

Display More

• Hi Roy,

  Thanks for your response.

  It's not working.

  Just highlighting one cell and hangs up.

Quote from royUK

Attach your workbook

Please find attached

Quote from royUK

Attach your workbook

Quote from Akhas

Please find attached

Where you able to work on it

Quote from royUK

This should work

Code

Sub FindmatchesAll()
    
    Dim rCl As Range, rFnd As Range, rSrc As Range
    Dim FirstFnd As String
    
    Set rSrc = Workbooks("Nifty All.xlsx").Sheets(1).Range("A1").CurrentRegion
    
    For Each rCl In ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion.Columns(1).Cells
        With rSrc.Cells
            Set rFnd = rSrc.Find(rCl.Value)
            If Not rFnd Is Nothing Then
                FirstFnd = rFnd.Address
                Do
                    rFnd.Interior.Color = vbGreen
                    Set rFnd = .FindNext(rFnd)
                Loop While Not rFnd Is Nothing And rFnd.Address <> FirstFnd
            End If
        End With
    Next rCl
End Sub

Display More

It worked Perfectly as your magic works always.

Thanks a Lot.