[Excel] Find Criteria and paste between workbooks and loop

[heywood89]

Apologies if this has already come up but I’m at a complete loss.

I have to work books - RS CONTRACT MANAGEMENT BOOK & CONTRACT EXTENSIONS.

I need a macro that will look at data from one and paste another column where the criteria has been satisfied.

For Example:

In CONTRACT EXTENSIONS look at the Contract Customer Name ($D$5, $D$6, $D$7 etc...) & Contract No ($C Matching Row).
Look in the RS CONTRACT MANAGEMENT BOOK and find the row that matches the Contract Customer Name ($B$5 etc...) & Contract No ($E Matching Row) criteria.
If both are satisfied, copy the Contract Extension Date ($E Whatever determined row)& Contract Extension No ($F Whatever determined row) from CONTRACT EXTENSIONS and paste it in to the End Date ($M Whatever determined row) & No of Extensions ($N Whatever determined row) in RS CONTRACT MANAGEMENT BOOK.

(Sorry if that is confusing, I know how you feel)

To be honest, I have a deadline on this so the complete code would be greatly appreciated!

Thanks in advance,
Adam.

[vbfbryce]

Assuming the data in both workbooks starts in row 5...

Have both books open. Put this code in one of them and step through.

I couldn't test it fully since I don't have your workbooks.

Sub MatchAndPaste()
    Dim wbExt As Workbook
    Dim wsExt As Worksheet
    Dim wbMgmt As Workbook
    Dim wsMgmt As Worksheet
    Dim custName As String
    Dim contNo As String
    Dim i As Long
    Dim j As Long
    Dim lr As Long  'last row of data in column D - name?
    Dim lrMgmt As Long  'last row of data in Management book
    
    Stop
    
    Set wbExt = Workbooks("ContractExtensions.xlsx")    'change this name to YOUR book name
    Set wsExt = wbExt.Worksheets(1)                     'assumes data is in first worksheet in book
    Set wbMgmt = Workbooks("ContractManagement.xlsx")   'change this name to YOUR book name
    Set wsMgmt = wbMgmt.Worksheets(1)                   'assumes data is in first worksheet in book
    
    lr = wsExt.Range("d" & Rows.Count).End(xlUp).Row
    lrMgmt = wsMgmt.Range("b" & Rows.Count).End(xlUp).Row
    For i = 5 To lr
        custName = wsExt.Range("d" & i).Value
        contNo = wsExt.Range("c" & i).Value
        For j = 5 To lrMgmt
            If wsMgmt.Range("b" & j).Value = custName And wsMgmt.Range("e" & j).Value = contNo Then
                wsMgmt.Range("m" & j).Value = wsExt.Range("e" & i).Value
                wsMgmt.Range("n" & j).Value = wsExt.Range("f" & i).Value
                j = lrMgmt
            End If
        Next j
    Next i
End Sub