Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to compare, find match and copy between workbooks
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 "Joel" wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to compare, find match and copy between workbooks
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 Compa", 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 "Gary" wrote: 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 "Joel" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to compare, find match and copy between workbooks
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 "Gary" wrote: 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 Compa", 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 "Gary" wrote: 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 "Joel" wrote: 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to compare, find match and copy between workbooks
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to compare, find match and copy between workbooks
Sorry , change Windows with Workbooks , and Worksheet with
Worksheets |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Compare Col A and Col M, if Match, Copy Col N to Col E | Excel Programming | |||
Macro to compare two sheets and then copy if match | Excel Programming | |||
Macro or VB to copy data between two workbooks by column A match | Excel Programming | |||
Is there a way to compare data on 2 different workbooks to find m. | Excel Worksheet Functions | |||
Find, Match, Compare or Search.... Help! | Excel Programming |