Compare columns in separate workbooks and paste between them

Meettu

New Member
Joined
Dec 20, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hello,

I am asking guidance with a following issue and would be very grateful if someone could push me towards right direction:

I have source table (1) with example data below.
1640034262204.png


Then I have table in another workbook (2) which doesn't have in columns C&D filled but but it could have same information in columns A:B and E:F as in source file.

1640034355295.png


I would like to create a macro that would compare workbook 1 and 2 and if duplicate values are found in columns A:B and E:F it would then copy and paste data from columns C:D from workbook 1 to workbook 2 as well.
Any kind of tips are welcome.
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
You might consider the following...

VBA Code:
Sub AnotherConcatenate()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRow1 As Long, LastRow2 As Long
Dim arr1 As Variant, arr2 As Variant, arr3 As Variant
Dim i As Long, j As Long

Set wb1 = Workbooks("AnotherConcatenate 211220.xlsm") 'Change to your source workbook
Set wb2 = Workbooks("OtherWorkbook.xlsm") 'Change to your target workbook
Set ws1 = wb1.Sheets(1)
Set ws2 = wb2.Sheets(1)
LastRow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
LastRow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
arr1 = ws1.Range("A2:F" & LastRow1)
arr2 = ws2.Range("A2:F" & LastRow2)

For i = 2 To UBound(arr1)
    For j = 2 To UBound(arr2)
        If arr1(i, 1) & arr1(i, 2) & arr1(i, 5) & arr1(i, 6) = _
                arr2(j, 1) & arr2(j, 2) & arr2(j, 5) & arr2(j, 6) Then
            arr2(j, 3) = arr1(i, 3)
            arr2(j, 4) = arr1(i, 4)
        End If
    Next j
Next i

ReDim arr3(2 To UBound(arr2), 1 To 2)
For i = 2 To UBound(arr2)
    arr3(i, 1) = arr2(i, 3)
    arr3(i, 2) = arr2(i, 4)
Next i
ws2.Range("C3:D" & LastRow2) = arr3
End Sub

Happy Holidays!

Tony
 
Upvote 0
Hello Tony,

Thank you I appreciate you took time to help me. This code works for my problem. Now I just have to implemented it into my own real data.
Also I have to take a closer look to Redim, as it is something that I haven't used before.

Happy Holidays !

Meettu
 
Upvote 0
You're very welcome. Glad it worked out.

Cheers!
 
Upvote 0
You're very welcome. Glad it worked out.

Cheers!
Hello again.

I do still actually have an issue and I believe it is because of the Redim - statement. In my workbook (2) there is also empty cells in columns C&D which should be there as they are new lines which do not have yet C&D values and as I am using below code it will not show any of them. Would you have an idea how to proceed for now on? Replacing value based on column 7 is something that I have tried inside a loop but haven't managed to do.

ReDim arr3(2 To UBound(arr2), 1 To 2)
For i = 2 To UBound(arr2)
arr3(i, 1) = arr2(i, 3)
arr3(i, 2) = arr2(i, 4)
Next i
ws2.Range("C3:D" & LastRow2) = arr3
End Sub

Br,

Meettu
 

Attachments

  • apu.PNG
    apu.PNG
    7.2 KB · Views: 6
Upvote 0
"This code works for my problem. Now I just have to implemented it into my own real data."

"I do still actually have an issue and I believe it is because of the Redim - statement."

The code was written to match the data in your images. If your "real data" is structured differently from your images then that may be an issue. (Next time, it'd be helpful if you used this forum's XL2BB feature to upload data.)

Curious why you think the ReDim statement may be an issue. It sizes the array arr3 to the match the number of rows in arr2, by 2 columns wide.
 
Upvote 0
Hello again,

apologize my last reply it was very unclear. Below is code based of on help of Tonyy.
It does transfer data to correct area (between column 30-35) when the column 71 value matches in both files.

But for some reason the brought data in arr3 is invalid and taken from wrong rows even though the value in column 71 matches.
Are you able spot something that would cause the invalid values? Its weird as file1 and file 2 are identical just at file 2 the column 30-35 are empty in the beginning.


VBA Code:
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRow1 As Long, LastRow2 As Long
Dim arr1 As Variant, arr2 As Variant, arr3 As Variant
Dim i As Long, j As Long

Dim lRow3 As Long
Dim lRow4 As Long


Set wb1 = Workbooks.Open("file1")
Set wb2 = Workbooks.Open("file2)
Set ws1 = wb1.Sheets(1)
Set ws2 = wb2.Sheets(1)

wb1.Activate
ws1.Select 

Range("BO7").NumberFormat = "@"
Range("BP7").NumberFormat = "@"
lRow3 = Range("BO" & Rows.count).End(xlUp).Row

For i = 7 To lRow3
    Cells(i, 71).NumberFormat = "@"
    Cells(i, 71) = Cells(i, 67) & Cells(i, 68)
Next i

wb2.Activate
ws2.Select

Range("BO7").NumberFormat = "@"
Range("BP7").NumberFormat = "@"
lRow4 = Range("BO" & Rows.count).End(xlUp).Row

For i = 7 To lRow4
    Cells(i, 71).NumberFormat = "@"
    Cells(i, 71) = Cells(i, 67) & Cells(i, 68)
Next i

ws1.Activate
Range("BS6").Value = "Reference"
ws2.Activate
Range("BS6").Value = "Reference"
 
LastRow1 = ws1.Cells(Rows.count, "A").End(xlUp).Row
LastRow2 = ws2.Cells(Rows.count, "A").End(xlUp).Row
ws1.Activate
arr1 = ws1.Range("A6:BS" & LastRow1)
arr2 = ws2.Range("A6:BS" & LastRow2)

For i = 7 To UBound(arr1)
    For j = 7 To UBound(arr2)
        If arr1(i, 71) = arr2(j, 71) Then
            
            arr2(j, 30) = arr1(i, 30)
            arr2(j, 31) = arr1(i, 31)
            arr2(j, 32) = arr1(i, 32)
            arr2(j, 33) = arr1(i, 33)
            arr2(j, 34) = arr1(i, 34)
            arr2(j, 35) = arr1(i, 35)

        End If
    Next j
Next i

ReDim arr3(6 To UBound(arr2), 1 To 6)
For i = 6 To UBound(arr2)
    arr3(i, 1) = arr2(i, 30)
    arr3(i, 2) = arr2(i, 31)
    arr3(i, 3) = arr2(i, 32)
    arr3(i, 4) = arr2(i, 33)
    arr3(i, 5) = arr2(i, 34)
    arr3(i, 6) = arr2(i, 35)
Next i

ws2.Range("AD7:AI" & LastRow2) = arr3


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top