VBA Macro to replace data based on matching ID columns-CodePudding

I am very new to VBA and I have a pretty specific requirement that I could use some help with figuring out.

Sub Button2_Click()
Dim OpenFileName As String
Dim wb As Workbook
'Select and Open workbook
OpenFileName = Application.GetOpenFilename
If OpenFileName = "False" Then Exit Sub
Set wb = Workbooks.Open(OpenFileName)
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

'Set variables for copy and destination sheets
'Use (1) instead of "Sheet1" or "Learners" to reference the first sheet within the workbook
Set wsCopy = Workbooks("Excel Test1.xlsx").Worksheets("Sheet1")
Set wsDest = Workbooks("Excel Test2.xlsm").Worksheets("Learners")

  '1. Find last used row in the copy range based on data in column A
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
  '2. Find first blank row in the destination range based on data in column A
  'Offset property moves down 1 row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

  wsCopy.Range("A2:E" & lCopyLastRow).Copy _
    wsDest.Range("A" & lDestLastRow)
    
  wsDest.Range("G2").Value = WorksheetFunction.Match(wsDest.Range("F2").Value, wsCopy.Range("A2:A11"), 0)
  
MsgBox ("Done")
End Sub

The code above is used inside of a button in order to open up a different excel spreadsheet and copy the data into my 'Master Spreadsheet'.

With the data that is being copy and pasted into the Master Spreadsheet I also want to be able to check the ID column and if any of the ID's match I want to replace the matching ID row with all of the corresponding ID data from the imported spreadsheet.

All of the data below is dummy data and is not real, however for example, if ID 5 (John Harris) matches ID 5 (Michael Bailey) then I want all of Michael Bailey's data to be replaced with John Harris's data.

I hope that what I have written makes sense and I would appreciate any help with this.

CodePudding user response：

Try this:

Sub Button2_Click()
    
    Dim OpenFileName As String
    Dim wb As Workbook
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim m, rw As Range
    
    OpenFileName = Application.GetOpenFilename 'Select and Open workbook
    If OpenFileName = "False" Then Exit Sub
    
    Set wb = Workbooks.Open(OpenFileName, ReadOnly:=True)
    Set wsCopy = wb.Worksheets("Data") 'for example
    
    For Each rw In wsCopy.Range("A2:E" & wsCopy.Cells(Rows.Count, "A").End(xlUp).Row).Rows
        'matching row based on Id ?
        m = Application.Match(rw.Cells(1).Value, wsDest.Columns("A"), 0)
        'if we didn't get a match then we add a new row
        If IsError(m) Then m = wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row 'new row
        rw.Copy wsDest.Cells(m, "A") 'copy row
    Next rw
    
    wb.Close False 'no save
        
End Sub