VBA code to copy a row of data from one workbook to a master workbook based on unique cell value

[SimpleSusan]

Hi, as my name suggests, I'm not that cluey when it comes to writing VBA. I have read through a huge number of posts and still can't seem to get the code I need. My scenario is:

I have a workbook (AAA System File) that has worksheet (Master Summary) with data in it from B6 to AF6. The value in B6 is the unique ID for the file.

I have another workbook (AAB Incident Records) that contains a worksheet (Master Summary) with a list of IDs in column B.

What I want to do is code a command button in the AAA System File that when clicked:
1) copies the data from Worksheet "Master Summary" B6 to AF6
2) Opens workbook "AAB Incident Records"
3) Selects worksheet "Master Summary"
4) looks for the unique ID in column B that matches the copied cell B6 from the previous workbook
5) Once found, pastes the copied row of data in the correct row
6) Saves the file "AAB Incident Records"
7) Closes the file "AAB Incident Records"

Points 6 and 7 I can do easily. But no matter what I do, I can't seem to get the match then copy to work. I'd be happy to compromise have the entire row pasted rather than just the range B to AF.

I guess I'll need some sort of error handler also for the odd event where the copied ID does not appear in the AAB Incident Records "Master Summary" list

Can anyone help me please? Hopefully I've provided enough information.
Thanks, Susan

 

[AlphaFrog]

Try something like this. Set the path and file name for "AAB Incident Records" to suit.

[COLOR=darkblue]Sub[/COLOR] Copy_Matched_ID()
    
    [COLOR=darkblue]Dim[/COLOR] wbAAB [COLOR=darkblue]As[/COLOR] Workbook
    [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] Found [COLOR=darkblue]As[/COLOR] Range
    
    [COLOR=darkblue]Set[/COLOR] ws = ThisWorkbook.Worksheets("Master Summary")
      
    [COLOR=red]Set wbAAB = Workbooks.Open(ThisWorkbook.Path & "\AAB Incident Records.xls")[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] wbAAB.Sheets("Master Summary").Range("B:B")
        [COLOR=darkblue]Set[/COLOR] Found = .Find(What:=ws.Range("B6").Value, _
                          LookIn:=xlValues, _
                          LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlNext, _
                          MatchCase:=False)
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
                          
    [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Found [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
        Found.Resize(, 31).Value = ws.Range("B6:AF6").Value
        wbAAB.Close SaveChanges:=[COLOR=darkblue]True[/COLOR]
        MsgBox "Data copied and saved. ", vbInformation, "ID Matched"
    [COLOR=darkblue]Else[/COLOR]
        MsgBox "ID: " & ws.Range("B6").Value, vbExclamation, "No Match Found"
        wbAAB.Close SaveChanges:=[COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[SimpleSusan]

Wow, thank you so much. This works perfectly! I'm assuming if I need to extend the range I need to change the following line:

Found.Resize(, 31).Value = ws.Range("B6:AF6").Value

To (for example):

Found.Resize(, 33).Value = ws.Range("B6:AH6").Value

Cheers
Susan

 

[AlphaFrog]

You're welcome and your assumption is correct.