Long time lurker, first time poster. Usually I can find what I need in previous threads, but this one has beat me.
I have 2 worksheets that I use the below code to compare data in the two.
The code looks for the ID number in Sheet1 ColumnA and matches it to the ID number in Sheet2 ColumnA. Any cells in that row that do not match are highlighted on Sheet2 in yellow. Any missing ID from column A are highlighted red.
My question is how can I copy the entire row of the mismatched cells from Sheet2 and insert it below the corresponding row in Sheet1, and add the missing ID rows the bottom of the data in Sheet1.
Ideally Sheet1 end result would look like this:
I have 2 worksheets that I use the below code to compare data in the two.
The code looks for the ID number in Sheet1 ColumnA and matches it to the ID number in Sheet2 ColumnA. Any cells in that row that do not match are highlighted on Sheet2 in yellow. Any missing ID from column A are highlighted red.
My question is how can I copy the entire row of the mismatched cells from Sheet2 and insert it below the corresponding row in Sheet1, and add the missing ID rows the bottom of the data in Sheet1.
Ideally Sheet1 end result would look like this:
VBA Code:
Sub Changes()
Range("A1").Select
Dim ws1 As Worksheet, Ws2 As Worksheet
Dim ws1Data As Range, f As Range, cell As Range
Dim icol As Long
Set ws1Data = Worksheets("Sheet1").Columns(1).SpecialCells(xlCellTypeConstants)
With Worksheets("Sheet2")
For Each cell In Intersect(.UsedRange, .Columns(1)).SpecialCells(xlCellTypeConstants)
Set f = ws1Data.Find(what:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If f Is Nothing Then
Intersect(cell.EntireRow, .UsedRange).Interior.ColorIndex = 3
Else
For icol = 1 To .Range(cell, .Cells(cell.Row, .Columns.Count).End(xlToLeft)).Columns.Count - 1
If f.Offset(, icol) <> cell.Offset(, icol) Then
cell.Offset(, icol).Interior.ColorIndex = 6
End If
Next icol
End If
Next cell
End With
Range("A1").Select
End Sub
