Advertisement
|
[x]
Attachment Details
|
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: |
Option Explicit
Sub DiffFiles()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim filenameC As Variant
Dim filenameP As Variant
Dim wsC As Worksheet
Dim wsP As Worksheet
Dim wsN As Worksheet
filenameC = Application.GetOpenFilename("Excel Workbook (*.xls), *.xls")
If filenameC = False Then Exit Sub
filenameP = Application.GetOpenFilename("Excel Workbook (*.xls), *.xls")
If filenameP = False Then Exit Sub
Set wsC = Application.Workbooks.Open(filenameC).ActiveSheet
Set wsP = Application.Workbooks.Open(filenameP).ActiveSheet
Set wsN = Application.Workbooks.Add.ActiveSheet
Dim pasteRange As Range
Set pasteRange = wsN.Cells(1, 1) ' first row
Dim cel As Range
Dim match As Range
For Each cel In Intersect(wsC.Range("A:A"), wsC.UsedRange)
Set match = wsP.Range("A2:A65535").Find(cel)
If Not match Is Nothing Then
If match.Offset(, 1) <> cel.Offset(, 1) Then
cel.Offset(, 1).Copy pasteRange.Offset(, 1)
End If
If match.Offset(, 2) <> cel.Offset(, 2) Then
cel.Offset(, 2).Copy pasteRange.Offset(, 2)
End If
If pasteRange.Offset(, 1) <> "" Or pasteRange.Offset(, 2) <> "" Then
pasteRange = cel
Set pasteRange = pasteRange.Offset(1) ' next row
End If
Else
cel.Resize(, 3).Copy pasteRange
Set pasteRange = pasteRange.Offset(1) ' next row
End If
Next
For Each cel In Intersect(wsP.Range("A2:A65535"), wsP.UsedRange)
Set match = wsC.Range("A2:A65535").Find(cel)
If match Is Nothing Then
cel.Resize(, 3).Copy pasteRange
Set pasteRange = pasteRange.Offset(1) ' next row
End If
Next
End Sub
Open in New Window Zone:
Microsoft Excel Spreadsheet Software
|
|
[x]
The Solution Rating System
|
||
|
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
|
Loading Advertisement... |