Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Copying Data from 1 sheet to another if matched 1

Status
Not open for further replies.

robcarr

Programmer
May 15, 2002
633
GB
Dear All,

I have 2 sheets of data and some of the values on column A sheet 1 will match cloumn A sheet 2, what I would like to do is if a cell in sheet 1 col a matches a cell in sheet 2 col A, I would like to copy the value in sheet 1 column O in the same row and paste this into column 0 on sheet 2, I need this to loop through the sheet until all values in sheet 1 column A have been checked. Column A sheet 1 only contains numerics, column O, can have a micture, bt does generally contain text.

I am trying to adapt the coding I had from Dale Watson, as I am sure it will be similar, here is where I have got so far, I can get the data to be checked in column A on sheet 1 and then copy the value in column 0 and then go to sheet 2 but I can't get it to find the same item in sheet 2 and then paste into column 0. any help will be greatly appreciated.

Sub UpdateData()
Application.ScreenUpdating = False
Application.Goto Reference:="data"
ActiveCell.Offset(1, 0).Select
Do While ActiveCell.Value <> &quot;&quot;
Range(&quot;val&quot;) = ActiveCell.Value
If Range(&quot;valtest&quot;) = 1 Then
Selection.End(xlToRight).Select
Selection.Copy
Sheets(&quot;sheet2&quot;).Select
'this is the problem area, needs to go to the end of the row, and 1 cell over and then paste the value it found in sheet 1 into here.

Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Application.Goto Reference:=&quot;R1C1&quot;
Application.ScreenUpdating = True
 
This is how I have done this in the past, using the Find is the fastest way I have found to date. Give this a try and let me know if you like this method.

Code:
Sub CopyO()

Dim Match As Object
Dim i As Integer

i = 1
With Worksheets(2).UsedRange.Columns(1)
  Do
    Set Match = .Find(Worksheets(1).Cells(i, 1), LookAt:=xlWhole)
    If Not Match Is Nothing Then Worksheets(2).Cells(Match.Row, 15) _
      = Worksheets(1).Cells(i, 15)
    i = i + 1
  Loop While Not Len(Worksheets(1).Cells(i, 1)) = 0
End With

End Sub


Dave
 
thanks for doing this, it worked a treat, saved a colleague about 1 hours work.

Thanks
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top