Conditional Format and highlight difference between two excel files

Question

I have two different files that are generated every week by our team regarding product invoices. It has product id and order date column.

The same product can be ordered in different weeks. How to identify and highlight the order date column in the latest week that has same product id.

Ex:

Week 1:

Week 2:

In week 2 workbook I want to highlight the date for which product id is same in both week 1 and 2 but date is different (example here is ID:1234). Unable to conditional format because it gives me error as cannot apply between two different excel files. Allowed in same excel file but different sheets. My data here is in two different excel files (workbooks).

I cannot copy week 1 data to a new sheet in week 2 file because these excels need to be delivered to client as is and it is huge data. I just need to highlight the re-ordered items (change in date for same product).

Answer 1

Highlight Differences

Sub HighlightDifferences()

    Const SRC_FILE_PATH As String = "C:\Test\Week1.xlsx"
    Const SRC_SHEET As String = "Sheet1"
    Const SRC_EQUAL_COLUMN As Long = 1
    Const SRC_NOT_EQUAL_COLUMN As Long = 2
    
    Const DST_FILE_PATH As String = "C:\Test\Week2.xlsx"
    Const DST_SHEET As String = "Sheet1"
    Const DST_EQUAL_COLUMN As Long = 1
    Const DST_NOT_EQUAL_COLUMN As Long = 2
    Const DST_HIGHLIGHT_COLOR As Long = vbYellow
    
    ' Source
    
    Dim swb As Workbook: Set swb = Workbooks.Open(SRC_FILE_PATH)
    Dim sws As Worksheet: Set sws = swb.Sheets(SRC_SHEET)
    
    Dim serg As Range, snrg As Range, srCount As Long
    
    With sws.Range("A1").CurrentRegion
        srCount = .Rows.Count - 1
        If srCount < 1 Then
            MsgBox "No data in source worksheet.", vbCritical
            Exit Sub
        End If
        With .Resize(srCount).Offset(1)
            Set serg = .Columns(SRC_EQUAL_COLUMN)
            Set snrg = .Columns(SRC_NOT_EQUAL_COLUMN)
        End With
    End With
    
    Dim seData(), snData()
    
    If srCount = 1 Then
        ReDim seData(1 To 1, 1 To 1): seData(1, 1) = serg.Value
        ReDim snData(1 To 1, 1 To 1): snData(1, 1) = snrg.Value
    Else
        seData = serg.Value
        snData = snrg.Value
    End If
    
    'swb.Close SaveChanges:=False
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim nValue, sr As Long, eStr As String
    
    For sr = 1 To srCount
        eStr = CStr(seData(sr, 1))
        If Not dict.Exists(eStr) Then
            Set dict(eStr) = CreateObject("Scripting.Dictionary")
        End If
        nValue = snData(sr, 1)
        If Not dict(eStr).Exists(nValue) Then
            dict(eStr)(nValue) = Empty
        End If
    Next sr

    Erase seData
    Erase snData
    
'    Dim Key, Item
'
'    For Each Key In dict.Keys
'        Debug.Print Key
'        For Each Item In dict(Key).Keys
'            Debug.Print Item ' Debug.Print Format(Item, "mm\/dd\/yyyy")
'        Next Item
'    Next Key
    
    ' Destination
 
    Dim dwb As Workbook: Set dwb = Workbooks.Open(DST_FILE_PATH)
    Dim dws As Worksheet: Set dws = dwb.Sheets(DST_SHEET)
    
    Dim derg As Range, dnrg As Range, drCount As Long
    
    With dws.Range("A1").CurrentRegion
        drCount = .Rows.Count - 1
        If drCount < 1 Then
            MsgBox "No data in destination worksheet.", vbCritical
            Exit Sub
        End If
        With .Resize(drCount).Offset(1)
            Set derg = .Columns(DST_EQUAL_COLUMN)
            Set dnrg = .Columns(DST_NOT_EQUAL_COLUMN)
        End With
    End With

    Dim deData(), dnData()
    
    If drCount = 1 Then
        ReDim deData(1 To 1, 1 To 1): deData(1, 1) = derg.Value
        ReDim dnData(1 To 1, 1 To 1): dnData(1, 1) = dnrg.Value
    Else
        deData = derg.Value
        dnData = dnrg.Value
    End If
    
    ' The Loop
    
    Dim durg As Range, r As Long
    
    For dr = 1 To drCount
        eStr = deData(dr, 1)
        If dict.Exists(eStr) Then
            nValue = dnData(dr, 1)
            If Not dict(eStr).Exists(nValue) Then
                If durg Is Nothing Then
                    Set durg = dnrg.Cells(dr)
                Else
                    Set durg = Union(durg, dnrg.Cells(dr))
                End If
            End If
        End If
    Next dr
    
    ' Highlight
    
    If Not durg Is Nothing Then
        dnrg.Interior.ColorIndex = xlNone ' clear existing...
        durg.Interior.Color = DST_HIGHLIGHT_COLOR ' ... and apply new highlights
    End If
    
    'dwb.Save SaveChanges:=True
    
    ' Inform.
    
    MsgBox "Differences highlighted.", vbInformation
    
End Sub

Dictionary Contents Printed in the Immediate window (Ctrl+G)

4
07/02/2023
06/30/2023
07/01/2023
1
07/01/2023
07/02/2023
5
07/02/2023
07/01/2023
2
06/30/2023