vijyat
10-05-2014, 04:00 PM
Hi,
I was wondering is someone can kindly help me out withe the particular project of mine. In the attached picture, the image on the left is "Sheet 1" and it has random data that I need to scan against the image on the right which is the approved Master List. Basically what I am trying to do is that for each cell in Column B "Sheet1" verifies against Column A in"Sheet2". For every possible match it will go on to the next cell and for every non-match(unique ID not found in Sheet 2), it will copy the entire row of Sheet1(Col A + ColB + ColC) and paste it on Sheet3 row by row for every unique entry.
I started modifying a previous code found on the forum by Hobbinton73 & SamT however I seem to be getting an error. Please help. Appreciate any input.
12361
Here is the code
VB:
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("B"))
Sheet2.Activate
Set rngS2 = Intersect(Sheet2.UsedRange, Columns("A"))
Sheet3.Activate
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 the AU ID to Sheet3
Sheet3.Cells(iRow, 1) = c1
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 = 36
Next i
Let iTest = 0
Let iRow = iRow + 1
End If
End If
Next
End With
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 the AU ID to Sheet3
Sheet3.Cells(iRow, 1) = c2
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
End Sub
I was wondering is someone can kindly help me out withe the particular project of mine. In the attached picture, the image on the left is "Sheet 1" and it has random data that I need to scan against the image on the right which is the approved Master List. Basically what I am trying to do is that for each cell in Column B "Sheet1" verifies against Column A in"Sheet2". For every possible match it will go on to the next cell and for every non-match(unique ID not found in Sheet 2), it will copy the entire row of Sheet1(Col A + ColB + ColC) and paste it on Sheet3 row by row for every unique entry.
I started modifying a previous code found on the forum by Hobbinton73 & SamT however I seem to be getting an error. Please help. Appreciate any input.
12361
Here is the code
VB:
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("B"))
Sheet2.Activate
Set rngS2 = Intersect(Sheet2.UsedRange, Columns("A"))
Sheet3.Activate
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 the AU ID to Sheet3
Sheet3.Cells(iRow, 1) = c1
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 = 36
Next i
Let iTest = 0
Let iRow = iRow + 1
End If
End If
Next
End With
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 the AU ID to Sheet3
Sheet3.Cells(iRow, 1) = c2
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
End Sub