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

1 answer

  • answered 2020-01-18 19:20 CDP1802

    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