You are here:

Excel/copy data using vba

Advertisement


Question
QUESTION: Hi Tom,

Need vba Solution for: if the whole string in a cell in column B of sheet4 is equal to the whole string in column C of sheet2 then copy the corresponding row data of column A and column D of sheet4 to sheet2 corresponding row in column A and E respectively.

Thanks in advance.

ANSWER: nabam,

I would see it being something like this:

Sub Copydata()
Dim sh2 As Worksheet
Dim sh4 As Worksheet
Dim r2 As Range
Dim r4 As Range
Dim cell4 As Range
Dim cell2 As Range
Dim res As Variant
Set r2 = sh2.Range("C2", sh2.Cells(sh2.Rows.Count, "C").End(xlUp))
Set r4 = sh4.Range("B2", sh4.Cells(sh4.Rows.Count, "B").End(xlUp))
For Each cell4 In r4
 res = Application.Match(cell4, r2, 0)
 If Not IsError(res) Then
   Set cell2 = r2(res)
     sh2.Cells(cell2.Row, "A").Value = sh4.Cells(cell4.Row, "A").Value
     sh2.Cells(cell2.Row, "E").Value = sh4.Cells(cell4.Row, "D").Value
 End If
Next
End Sub

This implements the basics of what you describe.  There are other factors that might need to be considered (such as formatting, formulas, multiple matches, and other things), but this should get you started.

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: Giving error saying sub or function not defined. It direct to line "set cell2 = r2(res)". On some occasion it gives run-time error 91. I have multiple matches on sheet2.

ANSWER: Nabam,,

I left two commands out of the code.  So this should work

Sub Copydata()
Dim sh2 As Worksheet
Dim sh4 As Worksheet
Dim r2 As Range
Dim r4 As Range
Dim cell4 As Range
Dim cell2 As Range
Dim res As Variant
Set sh2 = Worksheets("Sheet2")
Set sh4 = Worksheets("Sheet4")
Set r2 = sh2.Range("C2", sh2.Cells(sh2.Rows.Count, "C").End(xlUp))
Set r4 = sh4.Range("B2", sh4.Cells(sh4.Rows.Count, "B").End(xlUp))
For Each cell4 In r4
 res = Application.Match(cell4, r2, 0)
 If Not IsError(res) Then
   Set cell2 = r2(res)
     sh2.Cells(cell2.Row, "A").Value = sh4.Cells(cell4.Row, "A").Value
     sh2.Cells(cell2.Row, "E").Value = sh4.Cells(cell4.Row, "D").Value
 End If
Next
End Sub


If you have multiple rows in Sheet2 that match a single row in sheet4 then you can use this:

Sub Copydata2()
Dim sh2 As Worksheet
Dim sh4 As Worksheet
Dim r2 As Range
Dim r4 As Range
Dim cell4 As Range
Dim cell2 As Range
Dim res As Variant
Set sh2 = Worksheets("Sheet2")
Set sh4 = Worksheets("Sheet4")
Set r2 = sh2.Range("C2", sh2.Cells(sh2.Rows.Count, "C").End(xlUp))
Set r4 = sh4.Range("B2", sh4.Cells(sh4.Rows.Count, "B").End(xlUp))
For Each cell4 In r4
 res = Application.Match(cell4, r2, 0)
 If Not IsError(res) Then
   For Each cell2 In r2
     If cell2 = cell4 Then
       sh2.Cells(cell2.Row, "A").Value = sh4.Cells(cell4.Row, "A").Value
       sh2.Cells(cell2.Row, "E").Value = sh4.Cells(cell4.Row, "D").Value
     End If
   Next
 End If
Next
End Sub

I did some light testing and both of these worked for me.

--
Regards,
Tom Ogilvy



---------- FOLLOW-UP ----------

QUESTION: Certainly there should be some mistake on my part. Actually sheet4 column B contains a list such as plumber, coolie, mild steel, stone agaggregate 15-25mm size, 1st class mason, etc. While column C of sheet2 contains lots of data including a words in a cell that exactly equal(matches) to the list in sheet4. Now suppose if a cell in  column C of sheet2 contain the word plumber then copy the data of sheet4 column A and E corresponding to row containing plumber and then paste at sheet2 column A and D respectively corresponding to row containing plumber. The word plumber exist at multiple locations in sheet2 column C. Similarly for other words that matches. I wish to mail you my workbook if you give me your email address.

Thanks again for your patience.

Answer
Nabam,

that is what the code should do.   

In your original question you said:
"then copy the corresponding row data of column A and column D of sheet4 to sheet2 corresponding row in column A and E"

the code does that with
      sh2.Cells(cell2.Row, "A").Value = sh4.Cells(cell4.Row, "A").Value
      sh2.Cells(cell2.Row, "E").Value = sh4.Cells(cell4.Row, "D").Value

Now however, you say:
"copy the data of sheet4 column A and E corresponding to row containing plumber and then paste at sheet2 column A and D respectively"

so you have reversed the roles of D and E in your latest post. If you want the code to change, then you would change
sh2.Cells(cell2.Row, "E").Value = sh4.Cells(cell4.Row, "D").Value
to
sh2.Cells(cell2.Row, "D").Value = sh4.Cells(cell4.Row, "E").Value


But you act like the code does not work at all.  For me it worked as I expected.  the routine CopyData2  does  handle the situation of Sheet2 having multiple matches.

The code is looking in the correct columns for the matches:
Set r2 = sh2.Range("C2", sh2.Cells(sh2.Rows.Count, "C").End(xlUp))
Set r4 = sh4.Range("B2", sh4.Cells(sh4.Rows.Count, "B").End(xlUp))

so column C of sheet2 and column B of sheet4.

If  you want to send a file, then you can send it to

twogilvy@msn.com

but I won't be able to get to that email for about 7 hours.

--
Regards,
Tom Ogilvy  
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.