Copying unique values (between columns A and B) from column A to Last Row+1 of column B

[tmsousa]

Hi everyone!

I'm looking to compare two columns on 2 different files. Let's call them Column 1A (File 1, always has the same file name and directory) and Column 2A (File 2, shares directory with File 1).

I want to extract the unique values from Column 1A that are not present in Column 2A and paste them at the very end of Column 2A. I also want to copy columns 1B, 1C and 1D for the values that were copied from Column 1A.

1A 1B 1C 1D
XXA XXB XXC XXD
YYA YYB YYC YYD
WWA WWB WWC WWD
ZZA ZZB ZZC ZZD

2A 2B 2C 2D
XXA XXB XXC XXD
YYA YYB YYC YYD

In this case, the macro would compare columns 1A and 2A. It would then find "WWA" and "ZZA" as a unique values on column 1A that are not present in column 2A. Then it would copy WWA, ZZA and their respective values on columns 1B, 1C and 1D and paste those 4 columns at the end of my used range on file 2 (in this case, file 2's table would now look like file 1's table). If this is a difficult / impossible step, then I can just use a vlookup between both files to bring in the data from columns 1B, 1C and 1D.

I hope this makes sense, my capabilities on VBA are quite limited and I'm struggling with this one. Please let me know if I can provide further info, any help would be really appreciated

Many thanks!!
Tiago

 

[mumps]

Place this macro in File1. Change the sheet names (in red) and the workbook name (in blue) to suit your needs.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, arr1 As Variant, arr2 As Variant, dic As Object
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    Set desWS = Workbooks("File2.xlsx").Sheets("Sheet1")
    arr1 = srcWS.Range("A1", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
    arr2 = desWS.Range("A1", desWS.Range("A" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr2, 1)
        If Not dic.Exists(arr2(i, 1)) Then
            dic.Add arr2(i, 1), Nothing
        End If
    Next i
    For i = 1 To UBound(arr1, 1)
        If Not dic.Exists(arr1(i, 1)) Then
            desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(arr1(i, 1), arr1(i, 2), arr1(i, 3), , arr1(i, 4))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[tmsousa]

Hi mumps,

If I interpret this correctly, this code needs the macro on the source file (which in my example is File 1). My source file is a system extract that refreshes every 24h... It's a new file every 24h, so I can't have a macro there. I need the macro to be on my example's File 2, i.e. the destination file. Apologies for being unclear, it's not easy to phrase this in English

2 other things:
- I realised the macro also needs to remove duplicates based on column 1A (literally the excel functionality "remove duplicates"). So it would remove all rows that have a duplicate value on column 1A (only on the source file).
- In the real life example, it's not columns A, B, C and D that I want to copy. It's actually B, C, E & H and paste them on the destination file on columns A, B, J, F (respectively) - this code wouldn't work for this specific example

--------------------------------------------


So if I re-phrase the whole thing...

• I want to use my Destination File to open my Source File and remove the rows when a value on column B is duplicate (Source File only).
• Then I want to compare Source File Column B to Destination File Column A and copy the unique values between these 2 columns into last row+1 on my Destination File column A.
• For those values that were copied from Source File, I also want to copy columns C, E & H and paste them on my Destination file on columns B, J & F, respectively.

Either way, thanks a lot for the help, I may be able to work some magic with it, as the code does what you said it does, so I can try to tweak it I'll feedback in the meantime!

Cheers,
Tiago

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your actual source sheet sheet and actual destination sheet showing the expected result. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[tmsousa]

I have to hide all the data as I'm not sure if I can share it - does the attached help?

I want to use the Destination File to open the Source file and remove all ticket no. that are duplicates. Then the macro compares Ticket no. column on both files and copies and pastes the unique values on the Source File into the Destination File, at the very end of the already existing list of ticket numbers. Then the values for Description, Status P and Project should be copied and pasted on the respective columns and row of the respective ticket, on the Destination File.

 

[mumps]

It's very hard to work with pictures. You could replace any confidential data with generic data. I would need only 8 or 10 rows of data as long as it is organized in exactly the same way as in your actual workbooks. Then follow the instructions in Post #4. I would also need the full path to the folder containing the Source file.

 

[tmsousa]

Right, I've created an example which is exactly what I have in my real life application.

Source File - https://drive.google.com/file/d/1PPKGtI3QWCQ49gqzqtyVmoJTorWEisFZ/view?usp=sharing
Destination File (with 2 tabs, one before running the macro, the other after running the macro) - https://drive.google.com/file/d/1AjrK4tJ996YeYBxuflys5JzADwmzmlku/view?usp=sharing

I've created a duplicate row on the Source File as this may happen, and the only difference is that there is a zero in front of the project name (Y34 becomes Y340, for example). I don't mind which row gets imported into the Destination file, as long as there is a unique Ticket number.

Does this help?

 

[tmsousa]

Also, forgot to mention - both files are in the same directory (which at the moment is my desktop). Even if they are moved from my desktop, they will always be together in the same directory!

 

[mumps]

In your Source File sheet, you have a comment in red at the bottom of column B. Please move it to column C so there is no data below the last Ticket No. in column B. Place this macro in the Destination workbook. Change the sheet names (in red) and the file name (in blue) to suit your needs. Make sure that the two files are saved in the same folder.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, desWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, dic As Object
    Dim Lastrow As Long, i As Long, x As Long, y As Long
    Set desWS = ThisWorkbook.Sheets("Dest File (after running macro)")
    arr1 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Value
    Workbooks.Open ThisWorkbook.Path & "\" & "SourceFile.xlsx"
    Set srcWS = Sheets("Source File")
    Lastrow = srcWS.Range("B" & Rows.Count).End(xlUp).Row
    srcWS.Range("C3:C" & Lastrow).RemoveDuplicates Columns:=1, Header:=xlYes
    arr2 = srcWS.Range("B3:B" & Lastrow).Resize(, 7).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        If Not dic.Exists(arr1(i, 1)) Then
            dic.Add arr1(i, 1), Nothing
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        If Not dic.Exists(arr2(i, 1)) Then
            With desWS
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = arr2(i, 1)
                .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0) = arr2(i, 2)
                .Cells(.Rows.Count, 6).End(xlUp).Offset(1, 0) = arr2(i, 7)
                .Cells(.Rows.Count, 10).End(xlUp).Offset(1, 0) = arr2(i, 4)
            End With
        End If
    Next i  
    ActiveWorkbook.Close False
    Application.ScreenUpdating = True
End Sub

 

[tmsousa]

Alright, so after a bit of testing and changing some small things, this final code fully works!

Sub RefreshData()

    Application.ScreenUpdating = False

Dim srcWB As Workbook, desWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, dic As Object

Dim Lastrow As Long, i As Long

Set desWS = ThisWorkbook.Sheets("Tracker")

arr1 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Value

Workbooks.Open ThisWorkbook.Path & "\" & "SourceFile.xlsx"

Set srcWS = Sheets("Raw Data")

With srcWS.Sort
.SetRange Range("B:AF")
.Header = xlYes
.Orientation = xlTopToBottom
.Apply
End With

Lastrow = srcWS.Range("B" & Rows.Count).End(xlUp).Row

For i = Lastrow To 3 Step by - 1
If srcWS.Cells(i, 2).Value = srcWS.Cells(i - 1, 2).Value Then
srcWS.Rows(i).Select
Selection.Delete shift:=xlUp
End If
Next

arr2 = srcWS.Range("B3:B" & Lastrow).Resize(, 7).Value

Set dic = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(arr1, 1)
If Not dic.Exists(arr1(i, 1)) Then
dic.Add arr1(i, 1), Nothing
End If
Next i

For i = 1 To UBound(arr2, 1)
If Not dic.Exists(arr2(i, 1)) Then
With desWS
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = arr2(i, 1)
.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0) = arr2(i, 2)
.Cells(.Rows.Count, 6).End(xlUp).Offset(1, 0) = arr2(i, 7)
.Cells(.Rows.Count, 11).End(xlUp).Offset(1, 0) = arr2(i, 4)
End With
End If
Next i

ActiveWorkbook.Close False
Application.ScreenUpdating = True

End Sub

Thank you so much mumps, I would've never have done this without your help!! To be fair, you did more than just help, you did the whole thing ahah

Cheers,
Tiago