Match data from one tab to another, and copy row to Third sheet

[bradjedis]

Greetings,

I am in need to have VBA to do the following.

On sheet 1, look at col A cell 2, and col b cell 2 to find a match on sheet 2. Sheet 2 will have 18 cols of data.

Sheet 1

Col A Col B
Number ID
12345A 12345

Sheet 2

Col A Col B
Number ID
12345A 12345
12345A 34567

IF Match, then copy Entire Row to Sheet 3 from Sheet 2


Any Help is greatly appreciated.

Brad

[HansV]

Where do you want to copy? To a fixed row, or below existing data?

[bradjedis]

Hans,

I would like to copy the entire row found, to sheet 3. First found would be row 2, next match would got to row 3 etc.

[HansV]

Try this:

Code: Select all

Sub CopyRow()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim r As Variant
    Dim s As Long
    ' Change the sheet names!
    Set ws1 = Worksheets("Sheet 1")
    Set ws2 = Worksheets("Sheet 2")
    Set ws3 = Worksheets("Sheet 3")
    r = Evaluate("MATCH(1, ('" & ws2.Name & "'!A1:A1000='" & ws1.Name & _
            "'!A2)*('" & ws2.Name & "'!B1:B1000='" & ws1.Name & "'!B2), 0)")
    If Not IsError(r) Then
        s = ws3.Range("A:A").End(xlUp).Row + 1
        ws2.Range("A" & r).EntireRow.Copy ws3.Range("A" & s)
    End If
End Sub

[bradjedis]

will let you know!

[bradjedis]

Hans,

I am not getting anything data wise onto the third sheet. Also, I am not getting any errors. I adjusted the Range for A1:A1000 and B1:B1000 according to the length of each tab.

I also adjusted the ws1-ws3 according to my sheet names.

[bradjedis]

Perhaps it is not looking correctly? Basically on sheet 1 use cell A2 and B2 to match to Sheet 2 cell A2 and B2. If match, copy entire row of data on sheet 2 to sheet 3

Just want to make sure I stated correctly.

[HansV]

Could you attach a sample workbook demonstrating the problem?

[bradjedis]

Hans,

Here is a sample

[HansV]

In your sample workbook, ALL rows match. Does that mean that you want to copy ALL rows from Sheet2 to Sheet3?

[bradjedis]

In that example, yes but there would be some not matching... change a few to make it not matching on sheet 2 for testing..

[HansV]

Thanks. Does this do what you want?

Code: Select all

Sub CopyMatching()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim r As Long
    Dim m As Long
    Dim s As Long
    ' Change the sheet names!
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set ws3 = Worksheets("Sheet3")
    m = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    s = ws3.Range("A" & ws3.Rows.Count).End(xlUp).Row
    For r = 2 To m
        If ws1.Range("A" & r).Value = ws2.Range("A" & r).Value And _
                ws1.Range("B" & r).Value = ws2.Range("B" & r).Value Then
            s = s + 1
            ws2.Range("A" & r).EntireRow.Copy ws3.Range("A" & s)
        End If
    Next r
End Sub

[bradjedis]

Getting better.

is giving me a type mismatch at:
Yellow arrow is pointing to the second row...

If ws1.Range("A" & r).Value = ws2.Range("A" & r).Value And _
ws1.Range("B" & r).Value = ws2.Range("B" & r).Value Then

I will take a look at the data.. and if you have any ideas let them flow.

[bradjedis]

When I run, I get three lines and then the type mismatch. But it is skipping some that should be in the final output.

[bradjedis]

Also, there is the case where there are several matches per number (due to another variable) not necessary for the match. I would have thought this would display all the matching rows because the data in A and B match

[HansV]

Could you please provide a workbook that is representative of your data? The code worked correctly for me in the workbook that you attached earlier.

[bradjedis]

Ok I will work on a sanatized version

[bradjedis]

Hans,

Hopefully this is representative.

[bradjedis]

Is it possible having blank cells on the second tab as part of the row of data to be copied? NOTHING is blank in Col A or B. However cols after that do contain nothing..

[bradjedis]

Perhaps Special characters? like the "/" could be causing a prob?