Compare, update or copy data from outside report
I'm trying to create sort of a planning sheet for me and my colleagues. Currently I'm looking for a solution to compare main planning file (let's call it Main.xlsm) and data that is provided by our ERP system (ERP.xlsm).
What I'm looking for is a VBA script that does the following:
1) opens a windows to select the source file (ERP system dump). It's identical as the report in my main Workbook.
2) it compares unique ID values from column F in both files (Sheet RAPORT in Main.xlsm and Sheet1 in ERP.xlsm) and:
If there is a match between Main.xlsm and ERP.xlsm - it updates values in Main with values from ERP (all data - rows A:AK)
if there is an entry in ERP but no entry in Main - it adds the whole row with that ID (A:AK)
if there is an entry in Main but no data in ERP - it places value "0" in row "R" in the Main file
Bonus round: Every time one of the above happens, it places a time/date stamp in column "AL" in the row from the unique ID it altered.
I was trying with the code below (it's the original version, not altered by me) but I can't figure out how to achieve all from above.
I would really appreciate any help with this because currently this task is eating lots of our work time to do by hand or simple functions.
Thanks in advance.
Sub import_tickets() 'run this when the active file is the main ticket list and the active sheet is the ticket list 'exported file must be open already, and the ticket list must be the active sheet Dim exported_file As String exported_file = "exported file.xlsx" header_exists = True 'if exported file doesn't have a header, set this to false! starting_row = 1 If header_exists Then starting_row = 2 Dim first_blank_row As Long first_blank_row = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row Dim r As Long r = starting_row Dim found As Range cur_ticket_num = Workbooks(exported_file).ActiveSheet.Range("a" & r).Value Do While Not cur_ticket_num = "" 'look for current ticket number in main file Set found = Columns("a:a").Find(what:=cur_ticket_num, LookIn:=xlValues, lookat:=xlWhole) If found Is Nothing Then 'add info to end of main file write_line_from_export exported_file, r, first_blank_row first_blank_row = first_blank_row + 1 Else 'overwrite existing line of main file write_line_from_export exported_file, r, found.Row End If r = r + 1 cur_ticket_num = Workbooks(exported_file).ActiveSheet.Range("a" & r).Value Loop End Sub Sub write_line_from_export(src_filename As String, src_r As Long, dest_r As Long) For c = 1 To 24 Cells(dest_r, c).Value = Workbooks(src_filename).ActiveSheet.Cells(src_r, c).Value Next c End Sub
Here is an example that uses a Dictionary object to compare the ID column between the 2 sheets.
Sub import_tickets() Dim sERPFileName As String Dim wbERP As Workbook, wsERP As Worksheet Dim wbMain As Workbook, wsMain As Worksheet Dim r, startrow, lastrow As Long Dim ID Dim dictERP Set dictERP = CreateObject("Scripting.Dictionary") With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = False .Show sERPFileName = .SelectedItems(1) End With Application.ScreenUpdating = False ' process ERP workbook Set wbERP = Workbooks.Open(sERPFileName, , xlReadOnly) Set wsERP = wbERP.Sheets("Sheet1") startrow = 2 ' assume has header lastrow = wsERP.Cells(Rows.Count, "F").End(xlUp).Row For r = startrow To lastrow ID = wsERP.Range("F" & r).Value If dictERP.exists(ID) Then MsgBox "Duplicate ID (" & ID & ") found in " & sERPFileName Else dictERP.Add ID, r End If Next r ' process MAIN workbook Set wbMain = ThisWorkbook Set wsMain = wbMain.Sheets("RAPORT") startrow = 2 ' assume has header lastrow = wsMain.Cells(Rows.Count, "F").End(xlUp).Row For r = startrow To lastrow ID = wsMain.Range("F" & r).Value If dictERP.exists(ID) Then ' update wsERP.Rows(dictERP(ID)).Columns("A:AK").Copy wsMain.Range("A" & r) wsMain.Range("L" & r) = "Updated " & Now dictERP.Remove (ID) Else ' set col R = 0 wsMain.Range("R" & r).Value = 0 wsMain.Range("L" & r) = "No Change " & Now End If Next r ' add from ERP those not matched If dictERP.Count > 0 Then For Each ID In dictERP.keys r = dictERP(ID) lastrow = lastrow + 1 wsERP.Rows(r).Columns("A:AK").Copy wsMain.Range("A" & lastrow) wsMain.Range("L" & lastrow) = "Added " & Now Next End If wbERP.Close Application.ScreenUpdating = True If dictERP.Count Then MsgBox dictERP.Count & " rows added" Else MsgBox "Done" End If End Sub