Transfer columns from comparable workbook if cell value exists

[jdelano]

This is a super simple example, I placed a button on my "old workbook" and when clicked it opens the "new workbook" and loops through the data in each. If a match between old and new is found then it copies the data from old to new and then marks the row in new with an X (so you can see which have been modified) when it is finished it brings the "new workbook" to the forefront so that you can manually check it.

the code:

    Dim newWorkBookFile As String
    Dim newWB As Workbook
    Dim newWBSheet As Worksheet
    Dim oldWBSheet As Worksheet
    
    Dim oldWBDataStartingRow As Long
    Dim newWBDataRow As Long
    
    Dim oldWBCurrentRow As Long
    Dim newWBFoundMatchingDescRow As Long
        
    Dim oldWBLastRow As Long
    
    Dim oldWBCurrentDesc As String
    Dim newWBCurrentDesc As String
        
    newWorkBookFile = "C:\Users\jd310\Documents\NewProjects.xlsx"
    
    Set oldWBSheet = ThisWorkbook.ActiveSheet
    
    Set newWB = Workbooks.Open(newWorkBookFile)
    Set newWBSheet = newWB.Sheets("Sheet1")
    
    oldWBDataStartingRow = 2
    
    ' find the last row with data in the old workbook in column A
    oldWBLastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).row
    
    ' loop through the rows in the current worksheet (old workbook)
    ' use the description column information
    ' and compare it to the description column in the new workbook
    ' if it is found then copy the data in cols C - F
    ' to the new workbook row
      
    For oldWBCurrentRow = oldWBDataStartingRow To oldWBLastRow
        
        ' the description to compare is found in column B
        oldWBCurrentDesc = oldWBSheet.Cells(oldWBCurrentRow, 2)
        
        newWBCurrentDesc = " " ' set this to 1 space so the Do loop starts
        newWBDataRow = 2  ' what row to start searching in the new workbook
        
        ' now loop through the new wookbook to see if this description is found
        ' stop when there is nothing contained in the description cell
        Do While Len(newWBCurrentDesc) > 0
            newWBCurrentDesc = newWBSheet.Cells(newWBDataRow, 2)
            
            If oldWBCurrentDesc = newWBCurrentDesc Then
                ' found the description, now copy the information over to the new workbook
                newWBSheet.Cells(newWBDataRow, 3).Value = oldWBSheet.Cells(oldWBCurrentRow, 3).Value
                newWBSheet.Cells(newWBDataRow, 4).Value = oldWBSheet.Cells(oldWBCurrentRow, 4).Value
                newWBSheet.Cells(newWBDataRow, 5).Value = oldWBSheet.Cells(oldWBCurrentRow, 5).Value
                newWBSheet.Cells(newWBDataRow, 6).Value = oldWBSheet.Cells(oldWBCurrentRow, 6).Value
                
                ' mark the row in the new wookbook as updated so you know which rows to manually check
                newWBSheet.Cells(newWBDataRow, 7).Value = "X"
                
                Exit Do   ' once a match is found there is no need to keep looking in the new workbook
            End If
            newWBDataRow = newWBDataRow + 1
        Loop
        
    Next oldWBCurrentRow
    
    ' show the new workbook so it can be manually checked
    newWB.Activate

Here is what my spreadsheets look like