Look Up To Columns, if Match The Same Values Paste to Relevant Cell Values to Another Cell

Dear all masters,
I want to one suitable code. Read Entire "A" column and O Column,

if matches same value,

Paste to J, K column from Q,R columns Relevant Values.

Example:

Your code is reads Entire "A" Column, and reads one value as a "65",

and now reads Entire O Column,

And found same Value As a "65" at O3 Cell

Now Take The Values From Q3 and R3

And Paste to J3 and K3 ( i.e, 230 and 10)

This is process for lookup and paste the values to target cells until end of "A" Column end page data, to J and K columns.

Kindly Make the Good Macro code.

Please find the Example file.

Thanking You All.

Best Regards,
Prasad.

Try:

Sub CompareCols()
    Application.ScreenUpdating = False
    Dim Rng As Range
    Dim foundVal As Range
    Dim LastRow As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For Each Rng In Range("A3:A" & LastRow)
        Set foundVal = Range("O:O").Find(Rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundVal Is Nothing Then
            Range("Q" & foundVal.Row) = Range("J" & Rng.Row)
            Range("R" & foundVal.Row) = Range("K" & Rng.Row)
        End If
    Next Rng
    Application.ScreenUpdating = True
End Sub

Dear sir,

Thank you for providing the code. but your code is not producing @ J and K columns.

And Erased Existing Q and R Columns after using code.

Please find the Image.

Kindly make the correction for smooth and fast working code.

Thanking you.

My apologies. I got the ranges reversed. Try:

Sub CompareCols()
    Application.ScreenUpdating = False
    Dim Rng As Range
    Dim foundVal As Range
    Dim LastRow As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For Each Rng In Range("A3:A" & LastRow)
        Set foundVal = Range("O:O").Find(Rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundVal Is Nothing Then
            Range("J" & Rng.Row) = Range("Q" & foundVal.Row)
            Range("K" & Rng.Row) = Range("R" & foundVal.Row)
        End If
    Next Rng
    Application.ScreenUpdating = True
End Sub

Glad to help.