We have two worksheets with similar records with same structure)(not in number of records). We want to know missing records in one worksheet with reference to other worksheet (Or) we want to find the intersection of both sheets.
Solution
Workbooks used are Workbook1.xls, Workbook2.xls, Results.xls
Workbook1 is having Src1 worksheet
Workbook2 is having Src2 worksheet
Results.xls is having Dest1 worksheet which will have Src1-Src2 records
Results.xls is having Dest2 worksheet which will have Src2-Src1 records
Dim Workbook1, Workbook2, Results As Workbook
Dim Src1, Src2, Dest1, Dest2 As Sheet1
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Windows("Workbook1.xls").Activate
Set Workbook1= ActiveWorkbook
Windows("Workbook2.xls").Activate
Set Workbook2= ActiveWorkbook
Windows("Results.xls").Activate
Set Results = ActiveWorkbook
'Renaming Results workbook sheet1 and sheet2 to Dest1 and Dest2
Results.Sheets(1).Name = "Dest1"
Results.Sheets(2).Name = "Dest2"
Workbook1.Activate
ActiveWorkbook.Sheets("Src1").Activate
Set Src1= ActiveSheet
Workbook2.Activate
ActiveWorkbook.Sheets("Src2").Activate
Set Src2= ActiveSheet
Results.Activate
ActiveWorkbook.Sheets("Dest1").Activate
Set Dest1 = ActiveSheet
ActiveWorkbook.Sheets("Dest2").Activate
Set Dest2 = ActiveSheet
Dim Src1rng As Range
Dim Src2rng As Range
'Select and assign range for Src1 sheet data
Src1.Activate
'Selecting range without headers by using offset(1,0)
Set Src1rng= Range("A1").CurrentRegion.Offset(1, 0)
'Select and assign range for Src2 sheet data
Src2.Activate
Set Src2rng= Range("A1").CurrentRegion.Offset(1, 0)
Dim row_not_exist As Boolean
'Select each row from the Src1rng
Src1.Activate
For Each Src1Row In Src1rng.Rows
row_not_exist = True
Src2.Activate
For Each Src2Row In Src2rng.Rows
'Comparing cell(s) in Src1rng with cell(s) with Src2rng
If Src1Row.Cells(1).Value = Src2Row.Cells(1).Value Then
If Src1Row.Cells(2).Value = Src2Row.Cells(2).Value Then
'if record exists in both sheets, no check needed further
row_not_exist = False
Exit For 'Don't compare with remaining records
End If
End If
Next Src2Row 'Go to next record in Src2
'If Src1rng record not exists in Src2rng then
'copy the Src1 record into Results workbook Dest1 sheet
If row_not_exist = True Then
Src1.Activate
Src1Row.Cells.Select
Selection.Copy
Dest1.Activate
ActiveCell.Offset(1, 0).Select
Dest1.Paste
Application.CutCopyMode = xlCopy
End If
Next Src1Row 'Go to next record in Src1
'we can find the viceversa by just changing the names from Src1 to Src2
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Dim Src1, Src2, Dest1, Dest2 As Sheet1
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Windows("Workbook1.xls").Activate
Set Workbook1= ActiveWorkbook
Windows("Workbook2.xls").Activate
Set Workbook2= ActiveWorkbook
Windows("Results.xls").Activate
Set Results = ActiveWorkbook
'Renaming Results workbook sheet1 and sheet2 to Dest1 and Dest2
Results.Sheets(1).Name = "Dest1"
Results.Sheets(2).Name = "Dest2"
Workbook1.Activate
ActiveWorkbook.Sheets("Src1").Activate
Set Src1= ActiveSheet
Workbook2.Activate
ActiveWorkbook.Sheets("Src2").Activate
Set Src2= ActiveSheet
Results.Activate
ActiveWorkbook.Sheets("Dest1").Activate
Set Dest1 = ActiveSheet
ActiveWorkbook.Sheets("Dest2").Activate
Set Dest2 = ActiveSheet
Dim Src1rng As Range
Dim Src2rng As Range
'Select and assign range for Src1 sheet data
Src1.Activate
'Selecting range without headers by using offset(1,0)
Set Src1rng= Range("A1").CurrentRegion.Offset(1, 0)
'Select and assign range for Src2 sheet data
Src2.Activate
Set Src2rng= Range("A1").CurrentRegion.Offset(1, 0)
Dim row_not_exist As Boolean
'Select each row from the Src1rng
Src1.Activate
For Each Src1Row In Src1rng.Rows
row_not_exist = True
Src2.Activate
For Each Src2Row In Src2rng.Rows
'Comparing cell(s) in Src1rng with cell(s) with Src2rng
If Src1Row.Cells(1).Value = Src2Row.Cells(1).Value Then
If Src1Row.Cells(2).Value = Src2Row.Cells(2).Value Then
'if record exists in both sheets, no check needed further
row_not_exist = False
Exit For 'Don't compare with remaining records
End If
End If
Next Src2Row 'Go to next record in Src2
'If Src1rng record not exists in Src2rng then
'copy the Src1 record into Results workbook Dest1 sheet
If row_not_exist = True Then
Src1.Activate
Src1Row.Cells.Select
Selection.Copy
Dest1.Activate
ActiveCell.Offset(1, 0).Select
Dest1.Paste
Application.CutCopyMode = xlCopy
End If
Next Src1Row 'Go to next record in Src1
'we can find the viceversa by just changing the names from Src1 to Src2
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Sample Output:
Src1 Sheet data | Src2 Sheet data | ||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
|
| ||||||||||||||||
Dest1 Sheet | Dest2 Sheet | ||||||||||||||||
|
|
Note:
Dest1 contains the missing(intersection) data, which available in Src1 but not in Src2
Dest2 contains the missing(intersection) data, which available in Src2 but not in Src1
Please let me know if any further queries, contact me psrdotcom@gmail.com
No comments:
Post a Comment