dormanino
07-30-2013, 09:41 AM
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
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