Highlight differences and copy whole row differences to new sheet

josros60

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

Rich (BB code):
INVOICE #ACCOUNT #Doc. DateAMOUNT

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,
 

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
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:


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

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

Rich (BB code):
INVOICE #ACCOUNT #Doc. DateEntryAMOUNTBALANCESHEETPAID
88861653261/15/2020525-3400.00#N/ANCL

thanks again.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,197
Messages
5,600,272
Members
414,374
Latest member
akbir

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