Need macro to merge data from 2 Worksheets into one sheet

[Henner]

Hi

It would be much appreciated if someone could provide me with macro code to do the following:

I have 2 Worksheets:
Worksheet 1 contains data in all cells in columns A to F only
Worksheet 2 contains data in all cells in columns A to R only

Column A in Worksheet 1 and Column G in Worksheet 2 only contain 5-digit numbers.

When the macro finds an exact match on a 5-digit number in both sheets, I need the entire row (18 cells of data) in Worksheet 2, copied and pasted to Worksheet 1 so that the 18 cells are pasted in, with the first copied cell in Column H and the last cell in column Y. The copied row needs to be copied to the same row as the matching number in Worksheet 1.

I hope I have explained it clearly!

Regards,
Paul

 

[mark.wagner]

first, I haven't tested this, so you only get the oklahoma guarantee :wink:
it was from an old macro that I used to do a similar problem, but utilizing a "fuzzy" match. I attempted to take out all the "fuzzy" parts and leave you with the matching code, but I did it on the fly, so apologies in advance if something's missing. and it didn't copy but 1 column, so you'll have to modify that I know.

it takes an "object" row, loops through all the "target" rows to find a match, if it hits one, it exits and goes to the next "object" row and repeats the search.

Sub run_match()
'
'Excel VB macro to compare two lists of names using "fuzzy" logic to return a measure of likeness.
'Mark Wagner 9/8/2005

Dim Src_row As Integer
Dim Target_row As Integer
Dim Match_max As Single
Dim Match_curr As Single
Dim Score_max As Integer
Dim Score_curr As Integer

'rows in source data
For Src_row = 2 To 6000
Match_max = 0
Score_max = 0

'rows in comparative data
For Target_row = 2 To 3600
Score_curr = 0

'first, check for exact match on street address and city
If Trim(Worksheets(2).Cells(Src_row, 9).Value) = Trim(Worksheets(3).Cells(Target_row, 5).Value) And _
Trim(Worksheets(2).Cells(Src_row, 10).Value) = Trim(Worksheets(3).Cells(Target_row, 6).Value) Then

Worksheets(2).Cells(Src_row, 24).Value = Worksheets(3).Cells(Target_row, 2).Value
'this copies the target cell values

Exit For 'if hit exact match, discontinue search for that source row

End If

Next Target_row

Next Src_row
ActiveWorkbook.Save
End Sub

an oklahoma guarantee is: if it breaks in two, you can keep both pieces. have fun!

 

[Henner]

Hi Mark,

Many thanks for providing the code. However, even though it runs without error, when I look in Sheet3 (is that where the results are meant to appear?), it is completely empty.

Sorry but I'm not an expert on macro code so if you can tell me what I need to change in the macro to make it work, it would be much appreciated.

Thanks.

Regards,
Paul

 

[mark.wagner]

try this Paul,
remember to change the number of rows you have to compare.

Sub run_match()
'
'Excel VB macro to compare two lists and return matching rows.
'Mark Wagner 11/08/2005

Dim Src_row As Integer
Dim Target_row As Integer

'rows in source data
For Src_row = 1 To 5

'rows in comparative data
For Target_row = 1 To 10

'first, check for exact match on columns 1 and 7
If Worksheets(1).Cells(Src_row, 1).Value = Worksheets(2).Cells(Target_row, 7).Value Then

'this copies the target cell values
With Worksheets(2)
.Range(.Cells(Target_row, 1), .Cells(Target_row, 18)).Copy Destination:=Worksheets(1).Range(Cells(Src_row, 8), Cells(Src_row, 26))
End With

Exit For 'if hit exact match, discontinue search for that source row

End If

Next Target_row

Next Src_row
'ActiveWorkbook.Save
End Sub