Highlight Differences

josros60

Well-known Member
Joined
Jun 27, 2010
Messages
521
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:

VBA 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,
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Try this

Rich (BB code):
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

Well-known Member
Joined
Jun 27, 2010
Messages
521
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

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Try this

VBA Code:
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Again with pleasure. Thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,122,314
Messages
5,595,441
Members
413,991
Latest member
waterstone

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top