VBA Comparison between 2 sheets that return a 3rd sheet with differences

[dormanino]

Hi, good day to all

Sorry if this thread is missing some information but it is my first post. I´m using excel 2013 VBA with the following macro to:

1 - Compare comlum "a" from a data pool sheet and a _base sheet;
2 - If data not exists, it copy´s from the selected sheet in a 3rd sheet cell by cell
3 - If data is found, it highlights the difference between the compared and actual cell
4 - in the code was used intersection statement but some items return as if it doesn´t exists
5 - The macro almost solve my problem but I´m still getting some inconsistencies and i´m not seeing it in the code as follows:

Thank you very much



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
Dim ans

Plan1.Activate
Set rngS1 = Intersect(Plan1.UsedRange, Columns("A"))
Plan2.Activate
Set rngS2 = Intersect(Plan2.UsedRange, Columns("A"))
Plan3.Activate
Plan3.Cells.Select
ans = MsgBox(prompt:="Do you really want to delete data in Sheet3?", _
Buttons:=vbYesNo + vbExclamation, _
Title:="Cool!")

If ans = vbNo Then Exit Sub ' vbNo = 7, vbYes = 6

Selection.Delete Shift:=xlUp
Plan3.Rows("1:1").Value = Plan1.Rows("1:1").Value

Let iRow = iRow + 2
With rngS2
'Search for Sheet1 AU 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 rows to Sheet3
For i = 1 To iCol
Plan3.Cells(iRow, i) = varS1(1, i)
If Not varH1(i) = 0 Then Cells(iRow, i) = 1
Next i
Let iTest = 0
Let iRow = iRow + 1
Else 'Check if rows are identical
Let varS1 = Intersect(Plan1.UsedRange, c1.EntireRow)
Let varS2 = Intersect(Plan2.UsedRange, c.EntireRow)
Let iCol = Intersect(Plan1.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
Plan3.Cells(iRow, i) = varS1(1, i)
If Not varH1(i) = 0 Then Cells(iRow, i) _
.Interior.ColorIndex = 20
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 AU 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 rows to Sheet3
For i = 1 To iCol
Plan3.Cells(iRow, i) = varS1(1, i)
If Not varH1(i) = 0 Then Cells(iRow, i) = 1
Next i
Let iTest = 0
Let iRow = iRow + 1

Else 'Check if rows are identical
Let varS1 = Intersect(Plan2.UsedRange, c2.EntireRow)
Let varS2 = Intersect(Plan1.UsedRange, c.EntireRow)
Let iCol = Intersect(Plan2.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
Plan3.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
Plan3.Select 'resize the columns
Range("A:Z").Columns.AutoFit
End Sub

[dormanino]

solved the issue:

if you don´t redimenionate and reset the value of varS1 and varH1 when the logic didn´t find the intersection on the "pool" sheet, it remained the former, the blank or nothing as value. You must reset it.

Sorry for the inconvenience.



Sub LookForDiscrepancies1()
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
Dim ans

Sheets("Pool de dados do gerenciamento").Activate
Set rngS1 = Intersect(Sheets("Pool de dados do gerenciamento").UsedRange, Columns("A"))
Sheets("_Base").Activate
Set rngS2 = Intersect(Sheets("_Base").UsedRange, Columns("A"))
Sheets("Plan2").Activate
Sheets("Plan2").Cells.Select
ans = MsgBox(prompt:="Do you really want to delete data in Sheet3?", _
Buttons:=vbYesNo + vbExclamation, _
Title:="Cool!")

If ans = vbNo Then Exit Sub ' vbNo = 7, vbYes = 6


Selection.Delete Shift:=xlUp
Sheets("Plan2").Rows("1:1").Value = Sheets("Pool de dados do gerenciamento").Rows("1:1").Value

Let iRow = iRow + 2
With rngS2
'Search for Sheet1 AU 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 rows to Sheet3
For i = 1 To iCol
Let varS1 = Intersect(Sheets("Pool de dados do gerenciamento").UsedRange, c1.EntireRow)
ReDim varH1(1 To iCol) As Integer
Sheets("Plan2").Cells(iRow, i) = varS1(1, i)
If Not varH1(i) = 0 Then
Cells(iRow, i) = 1
End If
Next i
Let iTest = 0
Let iRow = iRow + 1
Else 'Check if rows are identical
Let varS1 = Intersect(Sheets("Pool de dados do gerenciamento").UsedRange, c1.EntireRow)
Let varS2 = Intersect(Sheets("_Base").UsedRange, c.EntireRow)
Let iCol = Intersect(Sheets("Pool de dados do gerenciamento").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
Sheets("Plan2").Cells(iRow, i) = varS1(1, i)
If Not varH1(i) = 0 Then Cells(iRow, i) _
.Interior.ColorIndex = 20
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 AU 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 rows to Sheet3
For i = 1 To iCol
Let varS2 = Intersect(Sheets("Pool de dados do gerenciamento").UsedRange, c.EntireRow)
Let iCol = Intersect(Sheets("_Base").UsedRange, c2.EntireRow).Count
Sheets("Plan2").Cells(iRow, i) = varS1(1, i)
If Not varH1(i) = 0 Then Cells(iRow, i) = 1
Next i
Let iTest = 0
Let iRow = iRow + 1

Else 'Check if rows are identical
Let varS1 = Intersect(Sheets("_Base").UsedRange, c2.EntireRow)
Let varS2 = Intersect(Sheets("Pool de dados do gerenciamento").UsedRange, c.EntireRow)
Let iCol = Intersect(Sheets("_Base").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
Sheets("Plan2").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
Sheets("Plan2").Select 'resize the columns
Range("A:Z").Columns.AutoFit
End Sub