Copy data to another workbook where a unique identifier matches

[JCTalk]

Hiya all,

I've got so far, and now I'm officially stumped lol. Please can anyone help with the following...

Scenario: 'Master file' contains data to be copied to 'File to be uploaded to' which will not necessarily be in the same folder. The VBA in the 'Master file' should copy the data in columns J, K & L to columns M, N & O in the 'File to be uploaded to' where the unique identifiers match.

Before copying the data, it should check to see if any of the destination cells already have data in. If any of them do, a pop up a msgbox should be displayed warning of this, and asking if the data should be overwritten or cancel.

If any of the unique identifiers can't be found, it should skip to the next, but on completion of all the copying, display a msgbox detailing the number of successful updates and a list of the unique identifiers that couldn't be updated.

The number of rows to copy from the 'Master file' is not static so maybe it needs to count the unique identifiers column as there will never be any blanks in that column (column D).

The accessing, copying, saving and closing of 'File to be uploaded to' should be done behind the scenes. The user of the 'Master file' should not see any of this happening.

Thank you in advance to you ninjas that manage to crack this.

 

[Nebu]

Hi:

Your request is bit confusing, this is what I understood.

• You want copy columns J, K & L to columns M, N & O in the 'File to be uploaded to' into 'Master file'.
• The above columns should be matching with the unique identifier.
• You need a warning message if data already exist in 'Master file'.
• You need a count of unique identifier data copied and a list of unique identifier which are not found/ copied.

Here is what I did not get

• Wherein 'Master file' you want to paste the data.
• What is the difference between field to be copied here and another field.

However, I have coded as per my understanding. The code will basically pull data from a closed workbook and will do what you are looking for.

Sub test()
'Add reference for Microsoft Activex Data Objects Library-Microsoft Activex Data Objects 6.1 Library before running the macro
Application.ScreenUpdating = False
Dim Conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
'You need to update the below line with your desired path
cpath$ = ThisWorkbook.Path & "\File to be uploaded to.xlsx"
rsconn$ = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & cpath & "';" & _
            "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";"
Conn.Open rsconn

With Sheet1
    For i& = 7 To .Cells(Rows.Count, 4).End(xlUp).Row
' You need to update the field names in the below line as per your original file
                strSQL$ = "SELECT [AnotherField4],[AnotherField5],[AnotherField6],[FieldToCopy1Here],[FieldToCopy2Here],[FieldToCopy3Here] FROM [CopiedData$]WHERE [UniqueIdentifier] = '" & .Range("D" & i) & "'"
                On Error Resume Next
                rs.Open strSQL, Conn, adOpenStatic, adLockOptimistic, adCmdText
                ActiveSheet.Range("M" & i).CopyFromRecordset rs
                Set rs = Nothing
    Next
strmsg$ = WorksheetFunction.CountA(.Range("M7:M" & .Cells(Rows.Count, 4).End(xlUp).Row)) & " records updated." & vbNewLine
strmsg = strmsg & WorksheetFunction.CountA(.Range("D7:D" & .Cells(Rows.Count, 4).End(xlUp).Row)) - WorksheetFunction.CountA(.Range("M7:M" & .Cells(Rows.Count, 4).End(xlUp).Row)) & " records not found/updated."
MsgBox strmsg, vbInformation
End With
Application.ScreenUpdating = True
End Sub

Note:

I have put some instructions in the code itself please go through the same before running the macro.
Thanks

 

[JCTalk]

Hi Nebu

Thanks so much for the quick reply. To answer your questions...

• You want copy columns J, K & L to columns M, N & O in the 'File to be uploaded to' into 'Master file'.

The code will be ran from the 'master file'. J,K &L should be copied FROM the 'master file' TO M,N&O in the 'File to be uploaded to'.

• The above columns should be matching with the unique identifier.

Correct.

• You need a warning message if data already exist in 'Master file'.

The warning should be if the data already exists in the 'File to be uploaded to' where the data is being copied to.

• You need a count of unique identifier data copied and a list of unique identifier which are not found/ copied.

Correct.

Ref your clarification points...

• Wherein 'Master file' you want to paste the data.

Data is being copied to the 'File to be uploaded to' from the 'Master file'.

• What is the difference between field to be copied here and another field.

FieldToBeCopiedHere is a place holder for the columns where I'd like the data to be copied to. The other fields are unrelated fields that aren't part of the copy process. I have highlighted the columns that are of importance.

Many thanks Nebu.

 

[Nebu]

Hi:

This macro will work only if I can run it from 'File to be uploaded to' else I have code it not using ADO connection and open the workbook to paste and close it. You cannot include warnings for overwriting as it will repeat for each item and it will be irritating to cancel the warning messages for each item, other tahn that all what you have asked for will work for the attached.

Thanks

 

[JCTalk]

Hi Nebu.

Thanks for your reply. Unfortunately the macro will have to be ran from the 'master file'. The reason is because I will have a number of these master files for different people who I do not want to have direct access to the main 'file to be uploaded to'.

I want them to keep their own files, and this macro then upload their data to the 'file to be uploaded to'.

It doesn't matter if some of the functionality is not available. The most important part is that the macro needs to run from the 'master file'.

Thank you Nebu.

 

[Nebu]

Hi:

Use the following code on Master file.

Sub test()
Application.ScreenUpdating = False

Dim wb As Workbook
Dim sh As Worksheet
Dim rng As Range, fnd As Range
Dim x&

'You need to update the below line with your desired path
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "File to be uploaded to.xlsm")
Set sh = wb.Sheets(1)
j& = sh.Cells(Rows.Count, 1).End(xlUp).Row

With ThisWorkbook.Sheets(1)
    c& = .Cells(Rows.Count, 4).End(xlUp).Row
    Set rng = .Range("D7:D" & c)
End With

For i& = 3 To j
    With Sheet1
        Set fnd = rng.Find(What:=sh.Range("A" & i), LookAt:=xlWhole)

    If Not fnd Is Nothing Then
        .Range("J" & fnd.Row & ":L" & fnd.Row).Copy
        sh.Range("M" & i & ":O" & i).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        x& = x + 1
    End If
   
    End With

Next

MsgBox x & " out of " & i & " records updated", vbInformation, "Count"

Application.ScreenUpdating = True
End Sub

Note:
I have not included the warnings as it will appear for each of the Ids and will be irritating to cancel off every time the message pops up.
Thanks

 

[JCTalk]

Hi Nebu

Thank you for the new code. It works on the sample workbooks, but I can't seemed to make it work now I've made some small changes made to my files.

The 'master file' now has two tabs, "tab1" and "tab2". The layout is identical to the original 'master file' workbook, the only difference is the macro will copy data from "tab2" from exactly the same cell locations.

The 'File to be uploaded to' now has five tabs, call them "uploadtab1", "uploadtab2", "uploadtab3", "uploadtab4", "uploadtab5". The layout is identical to the original 'File to be uploaded to' workbook, the only difference is that the data should be copied to the 5th tab ("uploadtab5") in exactly the same cell locations.

Please can you help me amend your code Nebu? I tried it myself, and it mostly worked, it gave me the popup at the end saying what had been copied, but nothing had been copied so I assume it is the names/sheet numbers or something.

Thank you Nebu.

 

[Nebu]

Hi:
When you go to the VBA editor you will find something like below


The lines on the code which has Sheets(1) is the sheet number of the sheet that contains the data. The Sheet1 I am referring to in the macro, is the one which is colored in yellow (attached as thumbnail) . This is basically the index of the sheets. If you can change this in the code to suit your file the macro will work.

Thanks

 

[JCTalk]

Hi Nebu,

That's fantastic thank you. I understand. Got it working.

After it's finished copying, I'd like the macro to...

1. Run another macro in the 'File to be uploaded to' workbook. Lets call it TidyUp
2. Wait for the above macro to finish
3. RefreshAll pivots in the 'File to be uploaded to' workbook
4. Wait for the above refresh to finish
5. Save and close the 'File to be uploaded to' workbook

I've tried this...

wb.Application.Run TidyUP
DoEvents
wb.RefreshAll
DoEvents

But that doesn't seem to run.

Do you have any suggestions on how I can achieve that Nebu?

Thank you for all your help Nebu.

 

[Nebu]

Hi :

Call the macro from 'File to be uploaded to' workbook using the following code.
Application.Run ("'" & workbookname & "'!macroname")

Give this code after the msgbox line in the macro I have given.

Thanks

 

[JCTalk]

Hi Nebu. It worked great. Thanks so much for all your help.

Is there a place I can donate you some money like the other ninjas for helping me out?

 

[Nebu]

Hi:

I am not sure about any place where you can donate money, I am just a member like you ,no personal connection with any of the people who manage this site. Moreover, I actually do this as a hobby not for money , the only thing you can do is to like the solution if it solved your problem by clicking on the "Like".

Thanks