Macro to compare, find match and copy between workbooks

[Gary]

want to compare a user selection of cells (say A1:A10) in book2 to all
entries in book1 in column X. Find the matches and copy certain cells in the
matched row in book1 to book2.
this is what I have so far. It works except for the copy part.... it screws
up the selection for the loop.

Sub CompareAndCopy()

Dim xx As Long
Dim CompareRange As Variant, x As Variant, y As Variant

'first section to merge date and name togeter in book1.xls and copy to a
new (X) column. Book two has the name and date allready in column A


Windows("Book1.xls").Activate
'Have xx start at row 2
xx = 2
' Loop Through Target Depth & Objective until Blank Row is Found
Do While Cells(xx, 4).Value <> ""
'This will put the values of the fourth and tenth column
'together with in column 24 with a space in between the orignal
cell contents
Cells(xx, 24).Value = Cells(xx, 4) & " " & Cells(xx, 10).Value
xx = xx + 1
Loop

'second section compares selected range in book2.xls to range X1:X1435
if there is a match I want to copy a range of cells from book1 to book2

Windows("Book2.xls").Activate
' Set CompareRange equal to the range to which you will
' compare the selection.

'Set CompareRange = Range("C1:C5")
' NOTE: If the compare range is located on another workbook
' or worksheet, use the following syntax.
Set CompareRange = Workbooks("Book1.xls"). _
Worksheets("Book1").Range("X1:X1435")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.

For Each x In Selection
For Each y In CompareRange
If x = y Then Windows("Book1.xls").Activate
Range("O2:V2").Select
Selection.copy
Windows("Book2.xls").Activate
Range("P12").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next y
Next x

End Sub

 

[Joel]

1) you must include the sheetname.

thsi is no good
Workbook("ABC.xls").Range("A1")

You need something like this
Workbook("ABC.xls").Activesheet.Range("A1")
or
Workbook("ABC.xls").sheets("Sheet1").Range("A1")


2) You should use Workbooks instead of windows

3) Your nested for loops I don't think are correct. You wanted to compare
Row X in one workbook against the same row in the 2nd workbook.??? See
modified code. I used address to to get the cell from one workbook to use on
the second workbook.

4) I don't think the destination cell of the copy is correct.

Let me know if I need to make additional changes. Not 100% sure what you
need.




Sub CompareAndCopy()

Dim xx As Long
Dim CompareRange As Variant, x As Variant, y As Variant

'first section to merge date and name togeter in book1.xls and copy to a
'new (X) column. Book two has the name and date allready in column A



'Have xx start at row 2
xx = 2
' Loop Through Target Depth & Objective until Blank Row is Found
With Workbooks("Book1.xls").Worksheets("Book1")
Do While .Cells(xx, 4).Value <> ""
'This will put the values of the fourth and tenth column
'together with in column 24 with a space in between the orignal
'cell contents
.Cells(xx, 24).Value = .Cells(xx, 4) & " " & .Cells(xx, 10).Value
xx = xx + 1
Loop

'second section compares selected range in book2.xls to range X1:X1435
'if there is a match I want to copy a range of cells from book1 to book2

With Workbooks("Book2.xls").ActiveSheet
' Set CompareRange equal to the range to which you will
' compare the selection.

'Set CompareRange = Range("C1:C5")
' NOTE: If the compare range is located on another workbook
' or worksheet, use the following syntax.
Set CompareRange = Workbooks("Book1.xls"). _
Worksheets("Book1").Range("X1:X1435")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.

For Each y In CompareRange
CompareAddress = y.Address
If x.Value = .Range(CompareAddress).Value Then
Workbooks("Book1.xls").Worksheets("Book1"). _
Range("O" & y.Row & ":V" & y.Row).Copy
.Range("P12").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
End If
Next y
End With
End Sub

 

[Gary]

Sorry for the confusion. I changed it so when X=y then msgbox (x) ** to
display the value of the match.

This works 100% - but rather than the msgbox I want to do a copy/paste of
data from the match. That is the part I cant get to work.

Everything else works.

Sub CompareAndCopy()

Dim xx As Long
Dim CompareRange As Variant, x As Variant, y As Variant

Windows("Book1.xls").Activate
'Have xx start at row 2
xx = 2
' Loop Through Target Depth & Objective until Blank Row is Found
Do While Cells(xx, 4).Value <> ""
'This will put the values of the tenth and eleventh column
'together with a ' after column ten and a space in between
Cells(xx, 24).Value = Cells(xx, 4) & " " & Cells(xx, 10).Value
xx = xx + 1
Loop
Windows("Book2.xls").Activate
' Set CompareRange equal to the range to which you will
' compare the selection.

'Set CompareRange = Range("C1:C5")
' NOTE: If the compare range is located on another workbook
' or worksheet, use the following syntax.
Set CompareRange = Workbooks("Book1.xls"). _
Worksheets("Book1").Range("X1:X1435")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.

For Each x In Selection
For Each y In CompareRange
If x = y Then MsgBox (x)
Next y
Next x

End Sub

 

[Gary]

ok, I added this code for the user to select the range and set it to a
varaiable.

Set Datarange = Application.InputBox(prompt:="Please Select Range of Cells
to Compare:", Type:=8)

no my issue is that the code only allows one line of code after the the then
in the if/then/else statement?

that's why the copy/paste does not work

 

[Joel]

To aviod problems when working with two workbooks set variables to each
workbook that includes the sheet. If the sheet is the active sheet the use
"ACTIVESHEET". Avoid "selection" unless it is absolutely necessary. Use a
"Range" if possible.

Selection can get moved so it is always a good idea to capture the selection
at the beginning of the code like I did below.


Sub CompareAndCopy()

Dim xx As Long
Dim CompareRange As Variant, x As Variant, y As Variant

set SelectRange = Thisworkbook.activesheet.Selection

set bk1 = workbooks.("Book1.xls").Worksheets("Book1")
'Have xx start at row 2
xx = 2
' Loop Through Target Depth & Objective until Blank Row is Found
Do While bk1.Cells(xx, 4).Value <> ""
'This will put the values of the tenth and eleventh column
'together with a ' after column ten and a space in between
bk1.Cells(xx, 24).Value = bk1.Cells(xx, 4) & " " & bk1.Cells(xx,
10).Value
xx = xx + 1
Loop

' Set CompareRange equal to the range to which you will
' compare the selection.

' NOTE: If the compare range is located on another workbook
' or worksheet, use the following syntax.
Set CompareRange = bk2.Range("X1:X1435")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.

For Each x In SelectRange
For Each y In CompareRange
If x = y Then MsgBox (x)
Next y
Next x

End Sub

 

[ytayta555]

Maybe this line of code is what you are need :

For Each x In Selection
For Each y In CompareRange
If x = y Then
Windows("Book2.xls").Worksheet("YYYYY").Range("P12:YYYYY12").Value = _
Windows("Book1.xls").Worksheets("YYYYY").Range("O2:V2")

Next y
Next x

Make ajustaments to YYYYY for your need

 

[ytayta555]

Sorry , change Windows with Workbooks , and Worksheet with
Worksheets