Sub compare()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim lrow As Long, lr As Long
Dim lcol As Long
Dim z As Long
Dim rng As Range, cell As Range, r As Range, r2 As Range
Set ws = Sheets("Current")
Set ws1 = Sheets("Import")
lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
Set rng = ws.Range("A2:A" & lrow)
Set r = ws1.Range("A2:A" & lrow)
For Each cell In rng
If Application.WorksheetFunction.CountIf(r, cell.Value) = 1 Then
Set r2 = r.Find(What:=cell.Value, After:=ws1.Range("A2"), SearchOrder:=xlByRows, SearchDirection:=xlNext)
z = 2
Do Until z > lcol
If cell.Offset(0, z - 1).Value <> ws1.Cells(r2.Row, z) Then
cell.Offset(0, z - 1).Value = ws1.Cells(r2.Row, z)
cell.Offset(0, z - 1).Interior.ColorIndex = 3
End If
z = z + 1
Loop
End If
Next cell
End Sub
Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.
Connect with Certified Experts to gain insight and support on specific technology challenges including:
We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE