VBA copy values between 2 workbooks where X and X match?

Question

I have two workboks, one called slave and one called master.

Slave.xlsm

ID   Case Size      Names   
1    1o             Michael        
2    4              Katie              
3    3              Elliot

Master.xlsm

ID   Case Size      Names  
1    1o             
2    4              
3    3

From Slave workbook, I am trying to copy the values from Name column where the ID and Case Size matches in Master.

I'm new to VBA and so have tried to compile my own code below with the help of some examples online. Here's what i've got so far:

Sub GetTheName()
    Dim s As String, FileName As String

    s = "C:\Users\******\Documents\*.xlsm"
    FileName = Dir(s)
    Do Until FileName = ""
        If FileName Like "Slave*" Then MsgBox FileName

        Dim w1 As Worksheet, w2 As Worksheet
        Dim c As Range, FR As Long


        Application.ScreenUpdating = False

        Set w1 = Workbooks.Open(FileName).Sheets(1)
        Set w2 = ThisWorkbook.Sheets(1)


        For Each c In w1.Range("C10", w1.Range("C" & Rows.Count).End(xlUp))
            FR = 0
            On Error Resume Next
            FR = Application.Match(c, w2.Columns("A"), 0)
            On Error GoTo 0
            If FR <> 0 Then w2.Range("R" & FR).Value = c.Offset(, 0)
        Next c

        Application.ScreenUpdating = True
        FileName = Dir()
        ActiveSheet.Range("A8").Value = Now()
    Loop
End Sub

If i remove On Error Resume Next i get a type mismatch error on the below line:

 FR = Application.Match(c, w2.Columns("R"), 0)

The code opens the workbok but does not copy anything across. I'm not sure why nothing is being copied. Please can someone show me where i am going wrong? Thanks

Take out this: On Error Resume Next. Open the project explorer, press F8 to step through code. What happens? — Preston, Dec 19 '16 at 10:43
"tom preston thanks, when i take this line out i get a type mismatch error on this line FR = Application.Match(c, w2.Columns("R"), 0) — Princess.Bell, Dec 19 '16 at 10:53
@Bing.Wong since you want to compare both columns (A and B), you need to create a "Help" column D that is a "combined" string of the two. Then you need to use the `Macth` function between the values of "Column D" — Shai Rado, Dec 19 '16 at 12:57

Martin Router King · Answer 1 · 2016-12-19T11:40:13.913

I have managed to get what you want... I'm not sure if you will be interested in my answer, but it does what you want...

First add a column where you concatenate A and B columns in the slave page
Find the matches with INDEX - MATCH method

I added the concatenate column on the D column... so the formula would be like this...

 =INDEX(SLAVE!C2:C4;MATCH(CONCATENATE(MASTER!A2;MASTER!B2);SLAVE!D2:D4;0))

And this is the VBA code

Sub GetNames()
'
' GetNames Macro
'

'
LastRow = Sheets("SLAVE").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("SLAVE").Activate
Sheets("SLAVE").Range("D2").FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2])"
Sheets("SLAVE").Range("D2").AutoFill Destination:=Range("D2:D" & LastRow & ""), Type:=xlFillDefault 


LastRow = Sheets("MASTER").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("MASTER").Activate
Sheets("MASTER").Range("C2").FormulaR1C1 = _
        "=INDEX(SLAVE!RC:R[2]C,MATCH(CONCATENATE(MASTER!RC[-2],MASTER!RC[-1]),SLAVE!RC[1]:R[2]C[1],0))"
Sheets("MASTER").Range("C2").AutoFill Destination:=Range("C2:C" & LastRow & ""), Type:=xlFillDefault

End Sub

score 0 · Answer 2 · edited May 23 '17 at 11:53

0

Based on the type mismatch in your comment, I will point you to here:

Application.Match gives type mismatch

It's likely you're not fining a match in the specified range.

edited May 23 '17 at 11:53

Community

1
1

answered Dec 19 '16 at 10:56

Preston

7,399
8
54
84

score 0 · Answer 3 · answered Dec 19 '16 at 14:22

you could use AutoFilter():

Option Explicit

Sub main()
    Dim cell As Range, masterRng As Range

    With Sheets("Master") '<--| reference your "Master" sheet
        Set masterRng = .Range("A2", .Cells(.Rows.count, 1).End(xlUp)) '<--| reference its columns A cells from row 2 down to last not empty row
    End With

    With Sheets("Slave") '<--| reference your "Slave" sheet
        With .Range("B1", .Cells(.Rows.count, 1).End(xlUp)) '<--| reference its columns A and B from row 1 (headers) down to column A last not empty row
            For Each cell In masterRng  '<--| loop through "Master" sheet column A ID Size"
                .AutoFilter field:=1, Criteria1:=cell.Value '<--| filter it on its 2nd column (i.e. column B) with current cell offset 1 column value (i.e. current "Master" sheet "Case Size")
                .AutoFilter field:=2, Criteria1:=cell.Offset(, 1).Value '<--| filter it on its 2nd column (i.e. column B) with current cell offset 1 column value (i.e. current "Master" sheet "Case Size")
                If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any cell filtered other than headers
                    cell.Offset(, 2) = .Resize(.Rows.count - 1, 1).Offset(1, 2).SpecialCells(xlCellTypeVisible).Cells(1, 1) '<--|write first filtered 3rd column cell value in current cell offset 2 columns value (i.e. current "Master" sheet "Names")
                End If
            Next cell
        End With
        .AutoFilterMode = False
    End With
End Sub

@Bing.Wong, it'd be nice of you giving feedback to people trying help you — user3598756, Dec 21 '16 at 15:10
@Princess.Bell, I see you keep asking around for help. please find the time to give feedback too. thank you! — user3598756, Dec 27 '16 at 09:45
@Princess.Bell, could you find the time to give your feedback here?. Thank you — user3598756, Dec 31 '16 at 09:31

VBA copy values between 2 workbooks where X and X match?

3 Answers3