Find match within a column in a different worksheet, then copy paste specific cells to matched row i-CodePudding

I've got two workbooks, one named "LocalBooks" and another named "CentralIndex". All of the entries in the sheet "LocalBooks" have a unique reference number. I'm trying to write something that looks for a row in "CentralIndex" with that matching reference number and then updates specific columns in that row. (I do understand that a match and update entire row is a commonly asked question, but I couldn't find it for just updating specific columns in the row)

Workbook: "Localbooks" - Please assume first cell address is A1, sheet name is books

Workbook: "CentralIndex" - Please assume first cell address is A1, sheet name is Central Index

If my code runs correctly I'd like the "Central Index" to look like this:

With rows 2 (C2,E2,I2), 6 (C6,E6,I6) and 10 updated.

Considerations/Constraints

The above are sample sheets for my task, as I'm unable to share the actual data, but the actual sets are looking over 200 rows.
There won't be any duplicate reference numbers in the "Central Index" sheet. So multiple matches aren't an issue.
I did contemplate using an array, but got stuck on holding the multiple column values from "Books" and then putting them in the different columns. If there is a way to do that then I welcome it.
I cannot use a classic index/match or other formula solution as the ask is to "Make update with press button" and I cannot amend the "central index" sheet.
In a very ideal world, I'd love for the code to also highlight any rows in "Local Books" that were not matched in the "Central Index". But as my code is very not working I hadn't got that far.

My code below uses the match function to find the row address, however when I go to run it, nothing seems to happen....

Sub Update()

    Dim wbLocal As Workbook
    Dim wbCentral As Workbook
    Dim wsBooks As Worksheet
    Dim wsCentral As Worksheet
    Dim lrBooks As Long
    Dim lrCentral As Long
    Dim i As Long
    Dim rc As Variant
    
    Set wbLocal = Workbooks("LocalBooks.xlsx")
    Set wbCentral = Workbooks("CentralIndex.xlsx")
    Set wsBooks = wbLocal.Worksheets("Books")
    Set wsCentral = wbCentral.Worksheets("Central Index")

    lrBooks = wsBooks.Cells(wsBooks.Rows.Count, 1).End(xlUp).Row
    lrCentral = wsCentral.Cells(wsCentral.Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lrCentral
        rc = Application.Match(wsCentral.Cells(i, 1).Value, wsBooks.Range("A1:A" & lrBooks), 0)
        If Not IsError(rc) Then
            wsBooks.Range("D").Select
            Selection.Copy
            Windows("CentralIndex.xlsx").Activate
            wsCentral.Range("C").Select
            ActiveSheet.Paste
            Windows("LocalBooks.xlsx").Activate
        End If
    Next

End Sub

Debugging doesn't seem to pick anything up, so I haven't even been able to see if the copy paste part works either. (I'm aware that the current iteration of the copy paste won't get me the results above, I just wanted to see if what I'd done worked before using it for the other cells).

Happy to provide more info, and a giant thanks in advance. Promise I am learning so much from each question I ask :)

CodePudding user response：

Using a Dictionary Object with reference numbers as keys and corresponding Index sheet row numbers as values.

Option Explicit

Sub Update()

    Dim wbLocal As Workbook, wbCentral As Workbook
    Dim wsBooks As Worksheet, wsCentral As Worksheet
    Dim lrBooks As Long, lrCentral As Long
    Dim i As Long, r As Long, rc As Variant
    Dim n As Long, m As Long

    Dim dict As Object, key As String
    Set dict = CreateObject("Scripting.Dictionary")
    
    Set wbLocal = Workbooks("LocalBooks.xlsx")
    Set wbCentral = Workbooks("CentralIndex.xlsx")
    Set wsBooks = wbLocal.Worksheets("Books")
    Set wsCentral = wbCentral.Worksheets("Central Index")

    ' build lookup
    With wsCentral
        lrCentral = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = 2 To lrCentral
            key = Trim(.Cells(i, "B"))
            If dict.exists(key) Then
                MsgBox "Duplicate Ref No '" & key & "'", vbCritical, "Row " & i
                Exit Sub
            ElseIf Len(key) > 0 Then
                dict.Add key, i
            End If
        Next
    End With

    ' scan books, match ref numbers and update index
    With wsBooks
        lrBooks = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lrBooks
            key = Trim(.Cells(i, "A"))
            If dict.exists(key) Then
                r = dict(key)
                wsCentral.Cells(r, "C") = .Cells(i, "D") ' Status
                wsCentral.Cells(r, "E") = .Cells(i, "E") ' Date last loaned
                wsCentral.Cells(r, "I") = .Cells(i, "H") ' Currently loaned to
                n = n   1
            Else
                .Rows(i).Interior.Color = RGB(255, 255, 0)
                m = m   1
            End If
        Next
    End With
    MsgBox n & " records updated" & vbLf & m & " rows not found", vbInformation
End Sub

CodePudding user response：

If you want to do this in vba you should use a "dictionary". e.g. Runtime '6' Overflow Error - Refactoring Code for Stock Analysis

But based on your description I would recommend to use "Powerquery". In your "CentralIndex" workbook:

Go to menu data > Get data > from file > From workbook => choose "Localbooks.xlsx" and select the sheet to load
Click on "transform data"
On the top left you see "close and load" button, make sure to click on the litle triangle and choose "close and load to", check: connection only.
Go to your sheet in "CentralIndex", click in cell A1
Go to menu data > click on "From table range" and check "my table has header"

If all went well, you are back in powerquery and you have 2 queries (click on the left if you don't see them). To match:

Select 1 of them, click on the column you want to match
In menu "home" > "merge queries" => select the second table and column you want to match, leave the joinKind to left and hit OK.
You should see a new col with a dubbel arrow, click on the arrow and select the columns you want to add.
click on menu "close and load", this time choose the first option and load to new sheet

Let me know how it goes or if you get stuck.