cerebrolele
06-09-2012, 08:16 AM
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
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