ExcelBanter - Complex comparison of Columns of Data: Extracting unique records after comparison on 4 levels

Dear John,

thank you very much for you reply! After trying out your code, i
noticed that i was getting only the exact matches between the two
sheets. However, i was looking for all the records that have no exact
match.
Ofc this can be corrected with a simple insertion of the Else statement
in your very clear code. (See below).

Two remaining questions:

How do i get the records on Sheet2 that are unique to that sheet?
("VS0067157055 6 2400 2433" in the example)
Should i just copy paste this in a main2 and reverse the Sheetnames ?

Do you have a 'trick' or way to make the code less bulky?
(Though it is true that this was very easy to understand, and thus very
helpful and didactically apt.)

This is the code that i have now, which does the trick:

Sub main()
Dim myCheck1 As String
Dim myCheck2 As String
Dim myCheck3 As String
Dim myCheck4 As String
Dim lastCell1 As Long
Dim lastCell2 As Long
Dim lastCell3 As Long
Dim myRow As Long
Dim newRow As Long
Dim myCol As Long

lastCell1 = Sheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row
lastCell2 = Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row
lastCell3 = Sheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Row

myRow = 1 'change this to the first row containing data
myCol = 1 ' change this to the first column containing data
newRow = 1

For myRow = 1 To lastCell1
myCheck1 = Sheets("sheet1").Cells(myRow, myCol)
myCheck2 = Sheets("sheet1").Cells(myRow, myCol + 1)
myCheck3 = Sheets("sheet1").Cells(myRow, myCol + 2)
myCheck4 = Sheets("sheet1").Cells(myRow, myCol + 3)
'MsgBox myCheck1 & ", " & myCheck2 & ", " & myCheck3 & ", " & myCheck4
For newRow = 1 To lastCell2
If myCheck1 = Sheets("sheet2").Cells(newRow, myCol) Then
If myCheck2 = Sheets("sheet2").Cells(newRow, myCol + 1) Then
If myCheck3 = Sheets("sheet2").Cells(newRow, myCol + 2) Then
If myCheck4 = Sheets("sheet2").Cells(newRow, myCol + 3)
Then
'Sheets("sheet3").Cells(lastrow + 1, 1) = myCheck1
'Sheets("sheet3").Cells(lastrow + 1, 2) = myCheck2
'Sheets("sheet3").Cells(lastrow + 1, 3) = myCheck3
'Sheets("sheet3").Cells(lastrow + 1, 4) = myCheck4
'Nothing Should happen if all 4 Checks match, but if
they don't...
'
Else
Sheets("sheet3").Cells(lastCell + 1, 1) = myCheck1
Sheets("sheet3").Cells(lastCell + 1, 2) = myCheck2
Sheets("sheet3").Cells(lastCell + 1, 3) = myCheck3
Sheets("sheet3").Cells(lastCell + 1, 4) = myCheck4

End If
Else
Sheets("sheet3").Cells(lastCell + 1, 1) = myCheck1
Sheets("sheet3").Cells(lastCell + 1, 2) = myCheck2
Sheets("sheet3").Cells(lastCell + 1, 3) = myCheck3
Sheets("sheet3").Cells(lastCell + 1, 4) = myCheck4

End If

Else
Sheets("sheet3").Cells(lastCell + 1, 1) = myCheck1
Sheets("sheet3").Cells(lastCell + 1, 2) = myCheck2
Sheets("sheet3").Cells(lastCell + 1, 3) = myCheck3
Sheets("sheet3").Cells(lastCell + 1, 4) = myCheck4

End If

Else
Sheets("sheet3").Cells(lastCell + 1, 1) = myCheck1
Sheets("sheet3").Cells(lastCell + 1, 2) = myCheck2
Sheets("sheet3").Cells(lastCell + 1, 3) = myCheck3
Sheets("sheet3").Cells(lastCell + 1, 4) = myCheck4

End If
Next
Next

End Sub

John Bundy (remove) wrote:
Caught an error so as not to confuse, here is all of it, if you notice i
named my variable wrong at the bottom, and didn't put lastcell3 in a place
that would increment properly.
We all learn!!

Sub main()
Dim myCheck1 As String
Dim myCheck2 As String
Dim myCheck3 As String
Dim myCheck4 As String
Dim lastCell1 As Long
Dim lastCell2 As Long
Dim lastCell3 As Long
Dim myRow As Long
Dim newRow As Long
Dim myCol As Long

lastCell1 = Sheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row
lastCell2 = Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row

myRow = 1 'change this to the first row containing data
myCol = 1 ' change this to the first column containing data
newRow = 1

For myRow = 1 To lastCell1
myCheck1 = Sheets("sheet1").Cells(myRow, myCol)
myCheck2 = Sheets("sheet1").Cells(myRow, myCol + 1)
myCheck3 = Sheets("sheet1").Cells(myRow, myCol + 2)
myCheck4 = Sheets("sheet1").Cells(myRow, myCol + 3)
'MsgBox myCheck1 & ", " & myCheck2 & ", " & myCheck3 & ", " & myCheck4
For newRow = 1 To lastCell2
lastCell3 = Sheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Row
If myCheck1 = Sheets("sheet2").Cells(newRow, myCol) Then
If myCheck2 = Sheets("sheet2").Cells(newRow, myCol + 1) Then
If myCheck3 = Sheets("sheet2").Cells(newRow, myCol + 2) Then
If myCheck4 = Sheets("sheet2").Cells(newRow, myCol + 3) Then
Sheets("sheet3").Cells(lastCell3 + 1, 1) = myCheck1
Sheets("sheet3").Cells(lastCell3 + 1, 2) = myCheck2
Sheets("sheet3").Cells(lastCell3 + 1, 3) = myCheck3
Sheets("sheet3").Cells(lastCell3 + 1, 4) = myCheck4
End If
End If
End If
End If
Next
Next

End Sub

--
-John Northwest11
Please rate when your question is answered to help us and others know what
is helpful.

"ap" wrote:

Dear all,

as a relative VBA newbie I seem to have gotten into something a little
bit over my head :S

I have two lists on two different sheets, which I need to compare on
multiple levels. Usually I can manage by browsing this group and
creatively combine some of the previous solutions. However, atm I am at
a loss...

I have (as an example) on the first row of Sheet1:
Identifier (col A) b c d
VS0067157023 5 2424 2425
VS0067157024 5 2431 2433

Sheet2:
Identifier (col A) b c d
VS0067157023 5 2424 2425
VS0067157024 6 2431 2433
VS0067157055 6 2400 2433

Now comes the hard part (sorry if my english is not perfect...) I need
to compare this with the data on Sheet2:

- if there is an exact match on all four levels (A to D) in any row on
Sheet2 nothing happens
- if there is a mismatch on any level -- the record with the
identifier VS0067157024 needs to be written to Sheet3
- This example record is on row 2 on Sheet1, but might not be on row 2
on Sheet2 but on any row on Sheet2
- After is have done this, I also need to write the unique records from
Sheet2 to a Sheet4 (in this example the VS0067157055 record)

Two things I do know:
- on both sheets there are no empty cells in the list of Identifiers.
(Except after the last one ofc...)
- the data has the same format on both sheets, i.e. the same columns on
both sheets.

Any help would be greatly and utterly appreciated!

H.