Hi,
have the code below to compare column 1 but how to modify it to copy entire row when find difference to a new sheet,
Headings of sheet:
code:
Thank you,
have the code below to compare column 1 but how to modify it to copy entire row when find difference to a new sheet,
Headings of sheet:
Rich (BB code):
INVOICE # ACCOUNT # Doc. Date AMOUNT
code:
VBA Code:
Sub FIND_DIFFERENCES()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim c As Range, f As Range, mydiffs As Long
Dim r1 As Range, r2 As Range, lr As Long
Set sh1 = Sheets("NCL")
Set sh2 = Sheets("VENDOR")
Set sh3 = Sheets("DIFF")
Set r1 = sh1.Range("A2", sh1.Range("A" & Rows.Count).End(xlUp))
Set r2 = sh2.Range("A2", sh2.Range("A" & Rows.Count).End(xlUp))
r1.Interior.Color = vbWhite
r2.Interior.Color = vbWhite
For Each c In r1
Set f = r2.Find(c, , xlValues, xlWhole)
If f Is Nothing Then
c.Interior.Color = vbRed
mydiffs = mydiffs + 1
lr = sh3.Range("A" & Rows.Count).End(xlUp).Row + 1
sh3.Range("A" & lr).Value = c.Value
sh3.Range("D" & lr).Value = sh1.Name
End If
Next
For Each c In r2
Set f = r1.Find(c, , xlValues, xlWhole)
If f Is Nothing Then
c.Interior.Color = vbRed
mydiffs = mydiffs + 1
lr = sh3.Range("A" & Rows.Count).End(xlUp).Row + 1
sh3.Range("A" & lr).Value = c.Value
sh3.Range("D" & lr).Value = sh2.Name
End If
Next
MsgBox mydiffs & " differences found"
End Sub
Thank you,