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

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