Search, copy, and paste

[cjdhx9]

Hey everyone, I'm working on two excel documents. They both unique information related to an ID number. I'd like to take some info from document 1 and combine it with document 2, however document 2 has only certain ID's where document 1 has all the ID's. So I need to write a VBA module that can

*Use the ID number from Book2 to search for the same ID number in Book1.

*Copy info in the same row as Found ID (In Book1)

*Paste info in the same row as Original ID in Book2

I've been trying to make my own, and I've been looking through your forum, but I can't seem to find anything close. My VBA skills are limited.

Thanks

[Simon Lloyd]

Do you want to search only one worksheet in book1?

[cjdhx9]

Sorry, let me be more specific. I've attached an Example. I would like to search book1 for the IDs listed in Book2, once the ID is found I would like to copy the Energy and Power Values in the same Row back to Book2.

[cjdhx9]

heres book2.

[Simon Lloyd]

I havent looked at your workbooks as i was already working on something, but try this:
[vba]
Sub Import_Data()
Dim rFound As String
Dim Rng1 As Range, sCell As Range
Set Rng1 = Workbooks("book2").Sheets("Sheet1").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Application.ScreenUpdating = False
For Each sCell In Rng1
Workbooks("Book1").Worksheets("Sheet1").Activate
With Workbooks("Book1").Worksheets("Sheet1")
On Error Resume Next
rFound = .Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells.Find(What:=sCell, After:=.Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Address

If Range(rFound).Value <> sCell.Value Then GoTo Nxt
.Range(rFound).EntireRow.Copy Destination:=Workbooks("Book2").Sheets("Sheet1").Range(sCell.Address)
Nxt:
On Error GoTo 0
End With
Next sCell
Workbooks("Book2").Sheets("Sheet1").Activate
Application.ScreenUpdating = True
End Sub
[/vba]
Assuming the ID's are in column A on sheet 1 in both books. It also assumes both workbooks are open!

[mdmackillop]

Alternative method.
[VBA]Option Explicit
Sub Test()
Dim Lrw As Long
Workbooks("Book1.xls").Names.Add Name:="Data", RefersToR1C1:="=Sheet1!C1:C3"
With Workbooks("Book2.xls").Sheets(1)
Lrw = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("B2").FormulaR1C1 = "=VLOOKUP(RC1,Book1.xls!Data,2,FALSE)"
.Range("C2").FormulaR1C1 = "=VLOOKUP(RC1,Book1.xls!Data,3,FALSE)"
.Range("B2:C2").AutoFill Destination:=.Range("B2:C" & Lrw), Type:=xlFillDefault
'Remove formulae
.Range("B2:C" & Lrw).Value = .Range("B2:C" & Lrw).Value
End With
End Sub
[/VBA]

[cjdhx9]

Are there any methods using an If statement with the Find fuction?

[cjdhx9]

This is what I tried, but the "Set x = 12" returns as Object Required

[VBA]
Sub Copies()
Dim Find As Range
Dim x As Long
Set x = 12
Set Find = Workbooks("Visual_Basic_Study").Find(x).Offset(2).Activate
ActiveCell.Copy
Workbooks("Book2").Range("A1").Offset(2).Insert
Application.CutCopyMode = False
End Sub
[/VBA]

[mdmackillop]

X is a number, not an object so Set is not used. You Set a range, such as Set Rng = Range("A1")
This line
Set Find = Workbooks("Visual_Basic_Study").Find(x).Offset(2).Activate
need the worksheet and range added. You cannot seach an entire workbook.
The syyntax should be either
Set Find = MyRange.Find(x).Offset(2)
or
MyRange.Find(x).Offset(2).Activate
You cannot Set and Activate in one command.

However, it is not necessary to Activate a cell before copying it

[VBA]
Sub Copies()
Dim x As Long
x = InputBox("Enter number to find")
Workbooks("Visual_Basic_Study.xls").Sheets(1).Cells.Find(x, LookIn:=xlFormulas, LookAt:= _
xlWhole).Offset(2).Copy Workbooks("Book2.xls").Sheets(1).Range("A3")
Application.CutCopyMode = False
End Sub

[/VBA]

[mdmackillop]

Are there any methods using an If statement with the Find fuction?

What do you mean?