I want to compare two columns and copy cells

Question

I want to compare two columns and copy the 4 cells found next to the comparing value found in column 1, this row should than be copied into column 2 in the first empty row.

Sub Find_Matches()

    Dim CompareRange1 As Variant, CompareRange2 As Variant, x As Variant, y As Variant
    ' Set CompareRange equal to the range to which you will
    ' compare the selection.
    Set CompareRange1 = Range("A1:A10")
    Set CompareRange2 = Range("H1:H30") 
    For Each x In CompareRange1
        For Each y In CompareRange2
            Dim a As Variant
            Set a = x.Offset(0,4)
            If x = y Then y.Offset(1, 4) = a
        Next y
    Next x
End Sub

Why all the tags? access-vba, word-vba,outlook-vba and excel-vba all are slightly different. — Scott Craner
You also need to tell us what error you are getting and where. I do not see anywhere where you try to do what you want outside of looping through the two ranges. I do not see where you try to copy 4 cells and paste then in the next available row. — Scott Craner
Is this better? Sorry this is my first time asking a question. I am unsure which formula to use but I cant set a = x.Offset (0,4).Select — Laurie Pel
Is Set CompareRange2 = Range("H1:H30") For Each x In CompareRange1 On the same line? The For needs to be on a new line — danieltakeshi
Remove the .Select from that line. when setting you do not select. — Scott Craner

CLR CLR · Accepted Answer · 2017-09-19T15:29:32

I think this will do what you're after:

Sub Find_Matches()
    Dim CompareRange1 As Variant, CompareRange2 As Variant, x As Variant, y As Variant
    Set CompareRange1 = Range("A1:A10")
    Set CompareRange2 = Range("H1:H30")
    For Each x In CompareRange1
        For Each y In CompareRange2
            If x = y Then y.Offset(, 1).Resize(, 4).Value = x.Offset(, 1).Resize(, 4).Value
        Next y
    Next x
End Sub

I want to compare two columns and copy cells

1 Answers