Comparing spreadsheet - VBA almost working..
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?
Code:
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
