Comparison of 2 excel sheets and put ouput in a 3rd sheet

[Guest]

Hi,

I would need some help and advice how to compare two excel spreadsheets and
get the output of that comparison in a third excel spreadsheet.

I will give you a short description what kind of problem I have to solve:

-----------------
Spreadsheet 1

CUSTOMER INDUSTRY GEO REV. STEP ODDS IDENT.
Company A Automotive Europe 10000 5 50% ECT-123
Company B Electronic Europe 25000 3 25% QIT-456
Company C Automotive Asia 15000 6 75% APA-789
-----------------

-----------------
Spreadsheet 2

CUSTOMER INDUSTRY GEO REV. STEP ODDS IDENT.
Company B Electronic Europe 25000 3 25% QIT-456
Company M Automotive Asia 50000 6 75% APA-987
Company A Automotive Europe 10000 6 50% ECT-123
-----------------

And the output of the comparison shall look like this:

-----------------
Spreadsheet 3 (generated output)

SOURCE CUSTOMER INDUSTRY GEO REV. STEP ODDS IDENT.
Sheet 1 Company A Automotive Europe 10000 5 50% ECT-123
Sheet 2 Company A Automotive Europe 15000 6 60% ECT-123

Sheet 1 Company B Electronic Europe 25000 3 25% QIT-456
Sheet 2 Company B Electronic Europe 25000 3 25% QIT-456

Sheet 1 Company C Automotive Asia 15000 6 75% APA-789

Sheet 2 Company M Automotive Asia 50000 6 75% APA-987
-----------------

So the macro shall act in following steps:
1. Take first identification number of sheet 1 and search it in sheet 2.
2. List/copy the whole row of data of matches or mismatches in sheet 3 (see
example)
3. After the output of the comparison with the first identification number,
the macro shall get on with the second identification number and so on.

If you have any questions to my problem in order to help me, please contact
me.


Thank you very much for your help!

 

[Bernie Deitrick]

Try the macro below. Change the values of the Sh1 and Sh2 variables to reflect the actual sheet
names.

HTH,
Bernie
MS Excel MVP

Sub CombineSheets()
Dim myRow As Long
Dim mySht As Worksheet
Dim mycell As Range
Dim Sh1 As String
Dim Sh2 As String
Sh1 = "Sheet1"
Sh2 = "Sheet2"

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Combined").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Set mySht = Worksheets.Add
mySht.Name = "Combined"

With Worksheets(Sh1)
myRow = .Range("A65536").End(xlUp).Row
.Range("A1:B1").EntireColumn.Insert
.Range("A1").Value = "Sort"
.Range("B1").Value = "Source"
.Range("B2:B" & myRow).Value = Sh1
.Range("A2:A" & myRow).Formula = "=ROW()"
.UsedRange.Copy
mySht.Range("A1").PasteSpecial xlPasteValues
End With
With Sheets(Sh2)
myRow = .Range("A65536").End(xlUp).Row
.Range("A1:B1").EntireColumn.Insert
.Range("A1").Value = "Sort"
.Range("B1").Value = "Source"
.Range("B2:B" & myRow).Value = Sh2
.Range("A2:A" & myRow).FormulaR1C1 = _
"=IF(ISERROR(MATCH(RC[2],Sheet1!C[2],FALSE))," & _
"MAX(Sheet1!C,Sheet2!R1C1:R[-1]C)+1," & _
"INDEX(Sheet1!C,MATCH(RC[2],Sheet1!C[2],FALSE)))"
.UsedRange.Offset(1, 0).Copy
mySht.Range("A65536").End(xlUp)(2).PasteSpecial xlPasteValues
.Range("A1:B1").EntireColumn.Delete
End With
Worksheets(Sh1).Range("A1:B1").EntireColumn.Delete
With mySht
.Cells.Sort key1:=.Cells(1, 1), order1:=xlAscending, header:=xlYes
For myRow = .Range("A65536").End(xlUp).Row To 3 Step -1
If .Cells(myRow, 1).Value <> .Cells(myRow - 1, 1).Value Then
.Cells(myRow, 1).EntireRow.Insert
End If
Next myRow
.Range("A:A").EntireColumn.Delete
.Cells.EntireColumn.AutoFit
.Cells(1, 1).Select
End With
End Sub