Hi,

I am using a code to compare two spreadsheet.
One of the function is to copy the modified records in a different worksheet, highlighting changes element in red.
The script works, but ONLY when the cell is modified to "blank"(no value), I get coloured in red the upper cell instead of the correct one.

Here the script, any help?

Sub GDV()
    Dim WsA As Worksheet, WsB As Worksheet, WsC As Worksheet, WsD As Worksheet, WsE As Worksheet
    Dim rFind As Range, c As Range
    Dim I As Integer, ColCnt As Integer
     
    Set WsA = Worksheets("OldExport")
    Set WsB = Worksheets("NewExport")
    Set WsC = Worksheets("Changes")
    Set WsD = Worksheets("PosDeleted")
    Set WsE = Worksheets("PosAdded")
     
    ColCnt = WsA.Cells(1, Columns.Count).End(xlToLeft).Column
     
    With CreateObject("Scripting.Dictionary")
        For Each c In WsA.Range("A2", WsA.Range("A" & Rows.Count).End(xlUp))
            If Not .exists(c.Value) Then
                .Add c.Value, False
                Set rFind = WsB.Columns(1).Find(What:=c.Value, LookIn:=xlValues)
                If Not rFind Is Nothing Then
                    For I = 1 To ColCnt
                        If Not c.Offset(, I - 1) = WsB.Cells(rFind.Row, I) Then
                            If .Item(c.Value) = False Then
                                rFind.Resize(1, ColCnt).Copy WsC.Range("A" & Rows.Count).End(xlUp).Offset(1)
                                .Item(c.Value) = True
                            End If
                            WsC.Cells(Rows.Count, I).End(xlUp).Interior.ColorIndex = 3
                        End If
                    Next I
                Else
                    MsgBox c.Value & " PosID has been canceled!"
                    c.Resize(1, ColCnt).Copy WsD.Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
            End If
        Next c
        For Each c In WsB.Range("A2", WsB.Range("A" & Rows.Count).End(xlUp))
            If Not .exists(c.Value) Then
                MsgBox c.Value & " PosID has been added!"
                c.Resize(1, ColCnt).Copy WsE.Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next c
    End With
End Sub