Highlight differences and copy whole row differences to new sheet

[josros60]

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:

INVOICE #
ACCOUNT #
Doc. Date
AMOUNT

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,

 

[DanteAmor]

Try this

Change the "5" to the number of columns you want to copy. If you use 10 columns on each sheet then change all 5 by 10 in the highlighted lines:

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).Resize(1, 5).Value = c.Resize(1, 5).Value
      sh3.Range("A" & lr).Offset(, 5).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).Resize(1, 5).Value = c.Resize(1, 5).Value
      sh3.Range("A" & lr).Offset(, 5).Value = sh2.Name
    End If
  Next
  MsgBox mydiffs & " differences found"
End Sub

 

[josros60]

Thank you so much it worked, I changed it to "6" but one question the balance column shows n/a per below it should $200, may I know why.

INVOICE #
ACCOUNT #
Doc. Date
Entry
AMOUNT
BALANCE
SHEET
PAID
8886
165326
1/15/2020
525-3
400.00
#N/A
NCL

thanks again.

 

[DanteAmor]

You must change all 5 to 6:

sh3.Range("A" & lr).Resize(1, 5).Value = c.Resize(1, 5).Value
sh3.Range("A" & lr).Offset(, 5).Value = sh1.Name

 

[josros60]

Thank you so much, worked perfectly.