Find matching value row id from one workbook to another workbook

0
votes

I have two excels Book1.xlsm and Book2.xlsx. Book1 will have certain values like alpha, beta, gamma etc. (no repetition) in column A. And Book2 will have multiple occurrence of Book1 values like beta, beta, beta, alpha, alpha, gamma, gamma, gamma, gamma, gamma etc. The values in Book2 may not be alphabetically sorted but same values will be grouped together. Book2 values will be also in column A.

I have a macro designed in Book1.xlsm that should iterate over each value in Book1 column A and find the first row id where same value is present in Book2 column A. This row id should be then copied in corresponding column B of Book1. This is how my macro code looks like. When I run, it fails with Run Time error '1004': Application-defined or object-defined error

Option Explicit
Sub Get_Data()
    Dim wb1 As Worksheet
    Dim wb2 As Worksheet
    Dim wb2row As Integer
    Dim i As Integer
    Dim j As Integer
    Const A = "A"
    Const B = "B"



    Set wb1 = Workbooks("Book1.xlsm").Worksheets("Sheet1")
    Set wb2 = Workbooks("Book2.xlsx").Worksheets("Sheet1")

      'Both For loop start from row id 2.
       For i = 2 To wb1.Range("A2", wb1.Range("A2").End(xlDown)).Rows.Count
        For j = 2 To wb2.Range("A2", wb2.Range("A2").End(xlDown)).Rows.Count
  
           wb2row = Application.WorksheetFunction.Match(wb1.Cells(i, A), Range(wb2.Cells(j, A)), 0)
                    wb1.Cells(i, B).Copy (wb2.Cells(j, A))
       
            Exit For ' j loop

    
        Next j
     Next i

End Sub
3
excelvba
There are many issues with your code: (1) Range(wb2.Cells(j, A)) in the Match function is probably the cause of the error. Try replacing it with wb2.Range("A:A"). (2) Why the For j loop if you're using the Match function? (3) wb1.Cells(i, B).Copy (wb2.Cells(j, A)) doesn't go with the logic you outlined. Shouldn't you have wb1.Cells(i, B) = wb2row instead? – Super Symmetry
Thanks @SuperSymmetry I made the changes you have suggested. Replaced with Range(wb2.Range("A:A")), removed j loop completely and replaced copy with wb1.Cells(i, B) = wb2row. It still throws the same error. – stuart
If it's exactly the same error, I cannot think of the cause. However, if the error is Unable to get the Match property of the WorksheetFunction class, it means that the function could not get a match and you have to do some error handling as @VBasic2008 's answer suggests. Both errors have the same number (1004) – Super Symmetry
Another subtle issue to be aware of in the future: In the line wb1.Cells(i, B).Copy (wb2.Cells(j, A)) you surround the the destination of the Copy method with parentheses. This passes the value of the range to the Copy method rather than the range itself. Therefore, that line has the same effect as wb1.Cells(i, B).Copy wb2.Cells(j, A).Value and this will cause another run-time error – Super Symmetry

3 Answers

0
votes

You can make excel do the work for you. Try this (tested)

Sub Get_Data()
  With Workbooks("Book1.xlsm").Sheets("Sheet1")
    With .Range(.Range("B2"), .Range("A" & Rows.Count).End(xlUp).Offset(0, 1))
      .Formula2 = "=IFERROR(MATCH(A2,[Book2.xlsx]Sheet1!$A:$A,0),"""")"
      .Value2 = .Value2
    End With
  End With
End Sub
0
votes

Match Criteria, Return Row

Option Explicit

Sub Get_Data()
    
    ' Source
    Const srcFirst As Long = 2
    Const srcCol As String = "A"
    ' Destination
    Const dstFirst As Long = 2
    Const dstCol As String = "A"
    Const resCol As String = "B"

    ' Source
    Dim src As Worksheet
    Set src = Workbooks("Book2.xlsx").Worksheets("Sheet1")
    Dim rng As Range
    Set rng = src.Range(src.Cells(srcFirst, srcCol), _
        src.Cells(src.Rows.Count, srcCol).End(xlUp))
    Dim RowOffset As Long
    RowOffset = srcFirst - 1
    ' Destination
    ' 'ThisWorkbook' - the workbook containing this code.
    Dim dst As Worksheet
    Set dst = ThisWorkbook.Worksheets("Sheet1")
    
    Dim srcRow As Variant ' It could be an error value, hence 'Variant'.
    Dim i As Long
    
    For i = 2 To dst.Cells(dst.Rows.Count, dstCol).End(xlUp).Row
        srcRow = Application.Match(dst.Cells(i, dstCol), rng, 0)
        If Not IsError(srcRow) Then
            ' This will write the row.
            ' If you need index, then remove 'RowOffset'.
            dst.Cells(i, resCol).Value = srcRow + RowOffset
        Else
        ' no match found, e.g.:
            'dst.Cells(i, resCol).Value = ""
        End If
    Next i

End Sub
-1
votes

The second parameter of match function must be a range not a single cell.