View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Macro to compare, find match and copy between workbooks

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" wrote:

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