Consulting

Results 1 to 3 of 3

Thread: Compare values in 2 columns, if values match copy value in adjacent cell to new colum

  1. #1
    VBAX Regular
    Joined
    Mar 2017
    Posts
    34
    Location

    Compare values in 2 columns, if values match copy value in adjacent cell to new colum

    Hello VBA experts,

    Its been a long while since i tried using VBA and I'm running in to some problems. Im columns A-E in a spreadsheet and attempting the following:

    Columns A,B & D are populated with data. I need to:
    1. loop through the values in column D
    2. Compare each value in column D to all of the values in column A
    3. If there is a match, copy cell B which corresponds to the matching value in column A
    4. Paste that value in column E next to the corresponding matching value in column D


    If thats not too confusing...

    So as an example:

    A_B_C_D_E
    a_1___r
    g_2___a_1
    e_3___b
    d_4___c
    t_5___n

    In column D, a match for "a" is found in column A, row 1, and the value in column A, row 2 is pasted to the matching "a" in Column E.

    All ranges would need to be dynamic.

    I've tried piecing this together from examples i've found with not luck so far. Below is what i've been working with. I know its incorrect, and results in copying all of the values in column A to column E.

    Sub compareAndCopy()
    
        Dim lastRowA As Long
        Dim lastRowD As Long
        Dim lastRowE As Long
        Dim i As Integer
        Dim j As Integer
    
    
        Application.ScreenUpdating = False
    
    
        lastRowD = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "D").End(xlUp).Row
        lastRowA = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
        lastRowE = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "E").End(xlUp).Row
    
    
        For i = 1 To lastRowD
            For j = 1 To lastRowA
    
    
                If Sheets("Sheet1").Cells(i, 1).Value = Sheets("Sheet1").Cells(j, 1).Value Then
                    Sheets("Sheet1").Cells(i, 1).Offset(, 1).Copy Destination:=Sheets("Sheet1").Cells(i, 1).Offset(, 4)
            Exit For
       Exit For
                End If
            Next j
        Next i
        Application.ScreenUpdating = True
    End Sub
    I've attached the spreadsheet as well.

    Any help would be greatly appreciated!

    Thanks,

    ChrisRowMatchTest.xlsm

  2. #2
    VBAX Regular
    Joined
    Mar 2017
    Posts
    34
    Location
    To anyone interested, this worked for me:

    With Range("E2:E" & Range("D" & Rows.Count).End(xlUp).Row)
        .Columns(1).Formula = "=IFERROR(VLOOKUP(D2,A,2,0),"""")"
        .Columns(2).Formula = "=IFERROR(INDEX(B:B,MATCH(D2,A:A,0)),"""")"
        .Value = .Value
    End With

  3. #3
    VBAX Expert
    Joined
    Apr 2005
    Posts
    722
    Location
    Could a Column D value appear more than once in Column A?
    I didn't have to ask as they do on multiple occasions.

    It does not take long on your example attachment but it might take a few seconds on a very large file.
    Sub Maybe()
    Dim i As Long, ii As Long
    Application.ScreenUpdating = False
        For i = 2 To Cells(Rows.Count, "D").End(xlUp).Row
            For ii = 2 To Cells(Rows.Count, "A").End(xlUp).Row
                If Cells(ii, 1) = Cells(i, 4) Then Cells(i, Cells(i, Columns.Count).End(xlToLeft).Offset(, 1).Column) = Cells(ii, 1).Offset(, 1).Value
            Next ii
        Next i
    Application.ScreenUpdating = True
    End Sub
    Last edited by jolivanes; 10-11-2018 at 06:10 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •