Highlight Differences

[josros60]

Hi,

i have the code below to highlight the differences between two sheets, how can it be modify to copy differences to another sheet.

code:

Sub HIGHLIGHT_DIFFERENCES()
 Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, f As Range, mydiffs As Long
  Dim r1 As Range, r2 As Range
  Set sh1 = Sheets("NCL")
  Set sh2 = Sheets("VENDOR")
  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
    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
    End If
  Next
  MsgBox mydiffs & " differences found"
End Sub

thank you,

 

[DanteAmor]

Try this

Sub HIGHLIGHT_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
  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
      sh3.Range("A" & Rows.Count).End(xlUp)(2).Value = c.Value
    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
      sh3.Range("A" & Rows.Count).End(xlUp)(2).Value = c.Value
    End If
  Next
  MsgBox mydiffs & " differences found"
End Sub

 

[josros60]

Thank you very much, it worked.

one question, is it possible to add sheet names for the each differences so I know which sheets missing what.

thanks again.

 

[DanteAmor]

Try this

Sub HIGHLIGHT_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("B" & 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("B" & lr).Value = sh2.Name
    End If
  Next
  MsgBox mydiffs & " differences found"
End Sub

 

[josros60]

Thanks so much!

 

[DanteAmor]

Again with pleasure. Thanks for the feedback