Show differences between two data sets using a unique identifier through VBA? - vba

Question

I have researched this extensively but cannot seem to find a solution. I am attempting to create a macro that will compare data between two tables on different sheets and highlight differences using a unique identifier.
Here is an example:
Sheet 1 (Data Set 1)
UniqueID | Name | Date | Status
----------------------------------------
| 1230 | Bob | 1/1/2016 | Denied
| 6985 | Mike | 1/6/2016 | Pending
| 4442 | Will | 1/9/2016 | Approved
Sheet 2 (Data Set 2)
UniqueID | Name | Date | Status
----------------------------------------
| 1230 | Bob | 1/1/2016 | Denied
| 6985 | Mike | 1/6/2016 | Approved
| 4442 | Will | 2/27/2016 | Approved
In this case, the macro would use the shared Unique ID and field name between the data sets and determine the two changes: one to a status field and one to a date field.
Is this possible? Thank you!

Answer 1

if, as per you example, your data sets have UniqueID columns matching each other then you can code like follows:
Option Explicit
Sub main1()
Dim ds1 As Range, ds2 As Range, row As Range, col As Range, f As Range
Set ds1 = Worksheets("DataSet1").Range("A1").CurrentRegion '<--| change "DataSet1" to your actual "Data Set 1" sheet name
Set ds2 = Worksheets("DataSet2").Range("A1").CurrentRegion '<--| change "DataSet2" to your actual "Data Set 2" sheet name
For Each row In ds1.Columns(1).Cells '<--| loop through "Data Set 1" "UniqueID" values (in its column 1)
For Each col In ds1.Rows(row.row).Cells '<--| ...loop through "Data Set 1" "UniqueID" row cells...
If col.Value <> ds2(col.row, col.Column) Then '<--| ... if current cell value doesn't match corresponding "Data Set 2" one, then ...
col.Interior.Color = RGB(255, 0, 0) '<--| ...mark "Data Set 1" current cell...
ds2(col.row, col.Column).Interior.Color = RGB(255, 0, 0) '<--| ...mark corresponding "Data Set 2" one
End If
Next col
Next row
End Sub
otherwise, you must find first find Data Set 1 "UniqueID" corresponding cell in Data Set 2 1st column, like follows:
Option Explicit
Sub main2()
Dim ds1 As Range, ds2 As Range, row As Range, col As Range, f As Range
Set ds1 = Worksheets("DataSet1").Range("A1").CurrentRegion '<--| change "DataSet1" to your actual "Data Set 1" sheet name
Set ds2 = Worksheets("DataSet2").Range("A1").CurrentRegion '<--| change "DataSet2" to your actual "Data Set 2" sheet name
For Each row In ds1.Columns(1).Cells '<--| loop through "Data Set 1" "UniqueID" values (in its column 1)
Set f = ds2.Columns(1).Find(what:=row.Value, LookIn:=xlValues, lookat:=xlWhole) '<--| look for current UniqueID in "Data Set 2" column 1
If Not f Is Nothing Then '<-- if "Data Set 1" "UniqueID" found in "Data Set 2", then...
For Each col In ds1.Rows(row.row).Cells '<--| ...loop through "Data Set 1" "UniqueID" row cells...
If col.Value <> ds2(col.row, col.Column) Then '<--| ... if current cell value doesn't match corresponding "Data Set 2" one, then ...
col.Interior.Color = RGB(255, 0, 0) '<--| ...mark "Data Set 1" current cell...
ds2(col.row, col.Column).Interior.Color = RGB(255, 0, 0) '<--| ...mark corresponding "Data Set 2" one
End If
Next col
End If
Next row
End Sub

Answer 2

If you are looking for a VBA solution, then
if the data set 1 is in sheet Sheet1 and data set 2 in sheet Sheet2 then the below code will highlight the differences in red color.
Sub foo()
For i = 2 To 50 'considering 50 rows in Sheet1
For j = 2 To 50 'considering 50 rows in Sheet2
If Sheets("Sheet1").Cells(i, 1).Value = Sheets("Sheet2").Cells(j, 1).Value Then
For k = 1 To 4
If Sheets("Sheet1").Cells(i, k).Value <> Sheets("Sheet2").Cells(j, k).Value Then
Sheets("Sheet1").Cells(i, k).Interior.Color = RGB(255, 0, 0)
End If
Next k
End If
Next j
Next i
End Sub

Answer 3

Just conditional formatting will do it for you like this:
=B2<>INDEX(H$2:H$4,MATCH($A2,$G$2:$G$4,0))
You will need to change the ranges according to your sheets.
The layout I used was looking like this:

Answer 4

You should try out this code below.
Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)
Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
Dim report As Workbook, difference As Long
Dim row As Long, col As Integer
Set report = Workbooks.Add
With ws1.UsedRange
ws1row = .Rows.Count
ws1col = .Columns.Count
End With
With ws2.UsedRange
ws2row = .Rows.Count
ws2col = .Columns.Count
End With
maxrow = ws1row
maxcol = ws1col
If maxrow < ws2row Then maxrow = ws2row
If maxcol < ws2col Then maxcol = ws2col
difference = 0
For col = 1 To maxcol
For row = 1 To maxrow
colval1 = ""
colval2 = ""
colval1 = ws1.Cells(row, col).Formula
colval2 = ws2.Cells(row, col).Formula
If colval1 <> colval2 Then
difference = difference + 1
Cells(row, col).Formula = colval1 & "<> " & colval2
Cells(row, col).Interior.Color = 255
Cells(row, col).Font.ColorIndex = 2
Cells(row, col).Font.Bold = True
End If
Next row
Next col
Columns("A:B").ColumnWidth = 25
report.Saved = True
If difference = 0 Then
report.Close False
End If
Set report = Nothing
MsgBox difference & " cells contain different data! ", vbInformation, "Comparing Two Worksheets"
End Sub
Private Sub CommandButton1_Click()
'Compare2WorkSheets Worksheets("Sheet1"), Worksheets("Sheet2")
Set myWorkbook1 = Workbooks.Open("C:\familycomputerclub-website\Excel2007 \testcompare2.xlsx")
Compare2WorkSheets Workbooks("testcompare1.xlsm").Worksheets("Sheet1"), myWorkbook1.Worksheets("Sheet1")
End Sub