Ideally I would like the message box to display whether any discrepancies were identified in sheet 3.
The data in sheet 1&2 should be identical, so when the macro is run the results in sheet 3 should show no data because there is no discrepancy. Now, if there are discrepancies between the data in sheet 1 and sheet 2, sheet 3 will show those discrepancies and highlight them. (I have uploaded the image of Sheet 3 to show what that looks like. The data highlighted in Orange, at the top, is the correct data from sheet 1, and the data highlighted in Yellow, under the title Sheet 2 V Sheet 1, is the data with the discrepancies in sheet 2). Once the macro has been run i would like a message box at the end that returns the result of "x" discrepancies were identified (if we use the example of sheet 3 - the uploaded image- the message box would say 2 discrepancies were identified, but if there were no discrepancies identified between sheet 1 and sheet 2 then the message box would say no discrepancies were identified).
The data in sheet 1&2 should be identical, so when the macro is run the results in sheet 3 should show no data because there is no discrepancy. Now, if there are discrepancies between the data in sheet 1 and sheet 2, sheet 3 will show those discrepancies and highlight them. (I have uploaded the image of Sheet 3 to show what that looks like. The data highlighted in Orange, at the top, is the correct data from sheet 1, and the data highlighted in Yellow, under the title Sheet 2 V Sheet 1, is the data with the discrepancies in sheet 2). Once the macro has been run i would like a message box at the end that returns the result of "x" discrepancies were identified (if we use the example of sheet 3 - the uploaded image- the message box would say 2 discrepancies were identified, but if there were no discrepancies identified between sheet 1 and sheet 2 then the message box would say no discrepancies were identified).
VBA Code:
Sub LookForDiscrepancies()
Dim varS1, varS2, varH1, varH2
Dim rngS1 As Range, rngS2 As Range
Dim c As Range, c1 As Range, c2 As Range
Dim iRow As Integer, iCol As Integer, i As Integer, iTest As Integer
Sheet1.Activate
Set rngS1 = Intersect(Sheet1.UsedRange, Columns("A"))
Sheet2.Activate
Set rngS2 = Intersect(Sheet2.UsedRange, Columns("A"))
Sheet3.Activate
Sheet3.Cells.Select
Ans = MsgBox(prompt:="Do you really want to delete data in Sheet3?", _
Buttons:=vbYesNo + vbExclamation, _
Title:="Delete Data!")
If Ans = vbNo Then Exit Sub ' vbNo = 7, vbYes = 6
Selection.Delete Shift:=xlUp
Sheet3.Rows("1:1").Value = Sheet1.Rows("1:1").Value
Let iRow = iRow + 2
With rngS2
'Search for Sheet1 IDs on Sheet2
For Each c1 In rngS1
On Error GoTo 0
Set c = .Find(what:=c1.Value) 'Look for match
If c Is Nothing Then 'Copy the ID to Sheet3
Sheet3.Cells(iRow, 1) = c1
Sheet3.Cells(iRow, 2) = "exist in sheet 1 not in sheet 2"
Let iRow = iRow + 1
Else 'Check if rows are identical
Let varS1 = Intersect(Sheet1.UsedRange, c1.EntireRow)
Let varS2 = Intersect(Sheet2.UsedRange, c.EntireRow)
Let iCol = Intersect(Sheet1.UsedRange, c1.EntireRow).Count
ReDim varH1(1 To iCol) As Integer
For i = 1 To iCol
If Not varS1(1, i) = varS2(1, i) Then
Let iTest = iTest + 1
Let varH1(i) = 1
End If
Next i
If iTest Then 'Rows are not identical
For i = 1 To iCol
Sheet3.Cells(iRow, i) = varS1(1, i)
If Not varH1(i) = 0 Then Cells(iRow, i) _
.Interior.ColorIndex = 40
Next i
Let iTest = 0
Let iRow = iRow + 1
End If
End If
Next
End With
Let iRow = iRow + 0
Range("A1").Offset(iRow, 0).Value = "Sheet2 vs Sheet1"
Let iRow = iRow + 2
With rngS1
'Search for Sheet2 IDs on Sheet1
For Each c2 In rngS2
On Error GoTo 0
Set c = .Find(what:=c2.Value) 'Look for match
If c Is Nothing Then 'Copy the ID to Sheet3
Sheet3.Cells(iRow, 1) = c2
Sheet3.Cells(iRow, 2) = "exist in sheet 2 not in sheet 1"
Let iRow = iRow + 1
Else 'Check if rows are identical
Let varS1 = Intersect(Sheet2.UsedRange, c2.EntireRow)
Let varS2 = Intersect(Sheet1.UsedRange, c.EntireRow)
Let iCol = Intersect(Sheet2.UsedRange, c2.EntireRow).Count
ReDim varH2(1 To iCol) As Integer
For i = 1 To iCol
If Not varS1(1, i) = varS2(1, i) Then
Let iTest = iTest + 1
Let varH2(i) = 1
End If
Next i
If iTest Then 'Rows are not identical
For i = 1 To iCol
Sheet3.Cells(iRow, i) = varS1(1, i)
If Not varH2(i) = 0 Then Cells(iRow, i) _
.Interior.ColorIndex = 36
Next i
Let iTest = 0
Let iRow = iRow + 1
End If
End If
Next
End With
Sheet3.Select 'resize the columns
Range("A:Z").Columns.AutoFit
End Sub