• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Populate a date if the activity ID Matches

mapyrant

New Member
How Do I Write:

If the value in Column A of Sheet 1 matches any value from Sheet 2 Column A.... Return the value from the matching Rows Sheet C Column B.

Seems simple... is not!
 
Try the following :

Code:
Sub FindDupesAndCopy()
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
    Dim Rws1 As Long, Rng1 As Range, a As Range
    Dim Rws2 As Long, rng2 As Range, c As Range
    Dim NextRow As Long
    
    ' Set worksheets
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    Set sh3 = Sheets("Sheet3")

    ' Define ranges for Sheet1 and Sheet2
    Rws1 = sh1.Cells(sh1.Rows.Count, "A").End(xlUp).Row
    Set Rng1 = sh1.Range("A4,A18") ' Explicitly selecting A4 and A18
    Rws2 = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).Row
    Set rng2 = sh2.Range("A1:A" & Rws2)

    ' Identify the first empty row in Sheet3, Column A
    NextRow = sh3.Cells(sh3.Rows.Count, "A").End(xlUp).Row + 1
    
    ' Loop through selected cells in Sheet1
    For Each a In Rng1.Cells
        ' Check for a match in Sheet2, Column A
        For Each c In rng2.Cells
            If a.Value = c.Value Then
                ' Copy the matching value to the first empty row in Sheet3
                sh3.Cells(NextRow, 1).Value = a.Value
                NextRow = NextRow + 1 ' Move to next empty row
                Exit For ' Exit inner loop once a match is found
            End If
        Next c
    Next a
End Sub
 
Back
Top