VBA Copy row when / if values match *Brain Fried* - vba

Question

I have a workbook with 2 sheets: Masterlist (old data) and Results (new data) with unique identifiers in column A.
I'm trying to find a way to copy the row containing the most recent data from the Results tab onto the matching row in the Masterlist sheet
I have only been able to find a way to copy the new data at the bottom of the Masterlist
Sub UpdateML()
Dim wM As Worksheet, wR As Worksheet
Dim r1 As Range, r2 As Range
Dim cel1 As Range, cel2 As Range
Dim LastRow As Long
Application.ScreenUpdating = False
Set wM = ThisWorkbook.Worksheets("MasterList")
Set wR = ThisWorkbook.Worksheets("Results")
With wM
Set r1 = .Range("A1", .Cells(.Rows.Count, .Columns("A:A").Column).End(xlUp))
End With
With wR
Set r2 = .Range("A1", .Cells(.Rows.Count, .Columns("A:A").Column).End(xlUp))
End With
On Error Resume Next
For Each cel1 In r1
With Application
Set cel2 = .Index(r2, .Match(cel1.Value, r2, 0)) 'find match in Masterlist
If Err = 0 Then
copyResult cel2 'copy result to masterlist
End If
Err.Clear
End With
Next cel1
End Sub
Sub copyResult(cel As Range)
Dim w As Worksheet, r As Range
Set w = ThisWorkbook.Worksheets("Masterlist")
Set r = w.Cells(w.Rows.Count, Columns("A:A").Column).End(xlUp).Offset(1) 'next row
cel.EntireRow.Copy w.Cells(r.Row, 1)
End Sub

Answer 1

Your copyResult method (when setting the value of r) is picking up the bottom row + 1, so that's why it's being dumped at the bottom of the list.
You have a LastRow variable in the UpdateML method though, which is unused.
I've got it to work by using that as a counter variable to track the row index and passing that into the copyResult method. Like this:
Sub UpdateML()
Dim wM As Worksheet, wR As Worksheet
Dim r1 As Range, r2 As Range
Dim cel1 As Range, cel2 As Range
Dim LastRow As Long
Application.ScreenUpdating = False
Set wM = ThisWorkbook.Worksheets("MasterList")
Set wR = ThisWorkbook.Worksheets("Results")
With wM
Set r1 = .Range("A1", .Cells(.Rows.Count, .Columns("A:A").Column).End(xlUp))
End With
With wR
Set r2 = .Range("A1", .Cells(.Rows.Count, .Columns("A:A").Column).End(xlUp))
End With
LastRow = 1
On Error Resume Next
For Each cel1 In r1
With Application
Set cel2 = .Index(r2, .Match(cel1.Value, r2, 0)) 'find match in Masterlist
If Err = 0 Then
copyResult cel2, LastRow 'copy result to masterlist
End If
Err.Clear
LastRow = LastRow + 1
End With
Next cel1
End Sub
Sub copyResult(cel As Range, row As Long)
Dim w As Worksheet
Set w = ThisWorkbook.Worksheets("Masterlist")
cel.EntireRow.Copy w.Cells(row, 1)
End Sub
I'm a little rusty with VBA (not used it in around a year), so there may be more elegant solutions, but this is definitely one option.

Answer 2

Here is a different approach. It uses "Find" which is a little leaner. It also uses activesheets and cells rather than references.
Do you need to add missing items from Results to the Master list? This covers that. If Results col A is the same as MasterList col A this will also work
Sub itworks()
'''covers the above
On Error Resume Next ''Can change this to more preferred if error <> 0
Sheets("MasterList").Range("a1").Select
lo = Range("A" & Range("A:A").Rows.Count).End(xlUp).Offset(1).Address
Do Until ActiveCell.Address = lo
Sheets("Results").Range("A:A").Find(ActiveCell.Value).EntireRow.Copy ActiveCell''copies found row to your Active Cell
ActiveCell.Offset(1).Select
Loop
''Adds missing rows
Sheets("Results").Activate
Range("a1").Select
lo2 = Range("A" & Range("A:A").Rows.Count).End(xlUp).Offset(1).Address
Do Until ActiveCell.Address = lo2
Set missing = Sheets("MasterList").Range("A:A").Find(ActiveCell.Value)
If missing Is Nothing Then
ActiveCell.EntireRow.Copy Sheets("MasterList").Range("a1").End(xlDown).Offset(1)
End If
ActiveCell.Offset(1).Select
Loop
End Sub