CODEWITHSUNDEEP
vba
JC Aguirre
JC Aguirre

Reputation: 3

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

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

Upvotes: 0

Views: 80

Answers (2)

EoinS
EoinS

Reputation: 5482

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

Upvotes: 0

jonifen
jonifen

Reputation: 208

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.

Upvotes: 1

Related Questions