Match 2 columns over 2 sheets then copy entire row

Question

An example showing how the data is arranged.

I have 2 spreadsheets. One is large and not updated and one is small with more recent information. I am trying to update the larger one with information from the smaller one. Both sheets have data in the same columns (item # and supplier ID).

I am trying to match item #'s first because there are less duplicates. I used Match to return the row index of the matched item # in the first sheet, then checked whether the Supplier ID matched. If it does, I copy it to the first sheet. If not, I'm trying to get Match to find the next match by making a new range. I did this 3 times to try to get around duplicate Item IDs.

My code runs but I can't get it to transfer anything.

Sub UpdateSheet()

    Dim i As Integer

    Dim targetRow As Integer
    Dim nextTargetRow As Integer
    Dim lastTargetRow As Integer

    Dim totalRows As Integer
    Dim totalSearchRows As Integer

    Dim searchRange As Range
    Dim nextSearchRange As Range
    Dim lastSearchRange As Range

    totalRows = Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row
    totalSearchRows = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row

    'Sets search range to column in larger spreadsheet with Item #
    Set searchRange = Sheet1.Range(Sheet1.Cells(2, 4), Sheet1.Cells(totalSearchRows, 4))

    'For each item # in new spreadsheet
    For i = 2 To i = totalRows
        'Finds first row in search range which matches item #
        targetRow = Application.Match(Sheet5.Cells(i, 4), searchRange, 0)
        'If supplier ID column values match, replace entire row in Sheet 1 with values from corresponding row in Sheet5
        If Sheet5.Cells(i, 1).Value = Sheet1.Cells(targetRow, 1).Value Then
            Sheet1.Cells(targetRow, 1).EntireRow.Value = Sheet5.Cells(i, 1).EntireRow.Value
        'If supplier ID column values do not match, search for next item # match
        Else: Set nextSearchRange = Sheet1.Range("D" & targetRow + 1, "D" & totalSearchRows)
            nextTargetRow = Application.Match(Sheet5.Cells(i, 4), nextSearchRange, 0)
            If Sheet5.Cells(i, 1).Value = Sheet1.Cells(nextTargetRow, 1).Value Then
                Sheet1.Cells(nextTargetRow, 1).EntireRow.Value = Sheet5.Cells(i, 1).EntireRow.Value
            Else: Set lastSearchRange = Sheet1.Range("D" & nextTargetRow + 1, "D" & totalSearchRows)
                lastTargetRow = Application.Match(Sheet5.Cells(i, 4), lastSearchRange, 0)
                If Sheet5.Cells(i, 1).Value = Sheet1.Cells(lastTargetRow, 1).Value Then
                    Sheet1.Cells(lastTargetRow, 1).EntireRow.Value = Sheet5.Cells(i, 1).EntireRow.Value
                End If
            End If
        End If

    Next

End Sub

I know I should be doing this with a loop but can't think of how to set it up.

tigeravatar · Accepted Answer

I recommend using Range.Find combined with .FindNext to create a Find loop for the Item ID, which you can then use to verify if the Supplier ID also matches. Given the information provided in your example image and in your code, something like this should work for you:

Sub UpdateSheets()

    Dim wb As Workbook
    Dim wsData As Worksheet
    Dim wsNew As Worksheet
    Dim rSearchCell As Range
    Dim rFound As Range
    Dim sFirst As String
    Dim sMessage As String
    Dim sNotFound As String
    Dim lUpdateCounter As Long
    Dim bUpdated As Boolean

    Set wb = ActiveWorkbook
    Set wsData = wb.Sheets(1)
    Set wsNew = wb.Sheets(5)

    'Item ID is column D, search for that first
    For Each rSearchCell In wsNew.Range("D2", wsNew.Cells(wsNew.Rows.Count, "D").End(xlUp)).Cells
        bUpdated = False
        Set rFound = Nothing
        Set rFound = wsData.Columns("D").Find(rSearchCell.Value, wsData.Cells(wsData.Rows.Count, "D"), xlValues, xlWhole)
        If Not rFound Is Nothing Then
            'Match was found for the Item ID, start a loop to match the Supplier ID in column A
            sFirst = rFound.Address
            Do
                If LCase(wsData.Cells(rFound.Row, "A").Value) = LCase(wsNew.Cells(rSearchCell.Row, "A").Value) Then
                    'Found the matching supplier ID, update the Data sheet with the info from the New sheet
                    rFound.EntireRow.Value = rSearchCell.EntireRow.Value
                    lUpdateCounter = lUpdateCounter + 1
                    bUpdated = True
                    Exit Do 'Exit the Find loop and move to the next rSearchCell
                End If
                Set rFound = wsData.Columns("D").FindNext(rFound)
            Loop While rFound.Address <> sFirst
        End If
        If bUpdated = False Then
            sNotFound = sNotFound & Chr(10) & "Item ID: " & rSearchCell.Value & "    //    Supplier ID: " & wsNew.Cells(rSearchCell.Row, "A").Value
        End If
    Next rSearchCell

    sMessage = "Update completed for " & lUpdateCounter & " rows of data."
    If Len(sNotFound) > 0 Then
        sMessage = sMessage & Chr(10) & _
                   Chr(10) & _
                   "Unable to find matches for the following rows:" & _
                   sNotFound
    End If

    'Provide message to user indicating macro completed, and if there were any rows not found in wsData
    MsgBox sMessage, , "Update Completed"

End Sub

Match 2 columns over 2 sheets then copy entire row

Answers (2)

Related Questions