Below is a VBA script that will compare 2 spreadsheets, highlight the differences and add a note to each cell to show the value on the other sheet. Additionally all the differences are noted on the third sheet. The sample sheet can be found here.
Sub CompareWorkSheets()
Dim c1 As Range
Dim c2 As Range
Dim RowPos As Long
Sheet3.Range("A1") = "Row"
Sheet3.Range("B1") = "Column"
Sheet3.Range("C1") = "Sheet1"
Sheet3.Range("D1") = "Sheet2"
RowPos = 1
For Each c1 In Sheet1.UsedRange
If c1.Text <> Sheet2.Cells(c1.Row, c1.Column).Text Then
Sheet1.Cells(c1.Row, c1.Column).Interior.Color = RGB(255, 251, 204)
Sheet1.Cells(c1.Row, c1.Column).ClearComments
Sheet1.Cells(c1.Row, c1.Column).AddComment Sheet2.Cells(c1.Row, c1.Column).Text
Sheet2.Cells(c1.Row, c1.Column).Interior.Color = RGB(255, 251, 204)
Sheet2.Cells(c1.Row, c1.Column).ClearComments
Sheet2.Cells(c1.Row, c1.Column).AddComment c1.Text
RowPos = RowPos + 1
Sheet3.Cells(RowPos, 1) = c1.Row
Sheet3.Cells(RowPos, 2) = c1.Column
Sheet3.Cells(RowPos, 3) = c1
Sheet3.Cells(RowPos, 4) = Sheet2.Cells(c1.Row, c1.Column)
End If
Next c1
End Sub
Alternative version of the code leaves the first 2 sheets unchanged and shows all of the differences on the third sheet.
Sub CompareWorkSheets()
Dim c1 As Range
Dim c2 As Range
Dim RowPos As Long
Sheet3.Range("A1") = "Row"
Sheet3.Range("B1") = "Column"
Sheet3.Range("C1") = "Sheet1"
Sheet3.Range("D1") = "Sheet2"
RowPos = 1
For Each c1 In Sheet1.UsedRange
If c1.Text <> Sheet2.Cells(c1.Row, c1.Column).Text Then
Sheet3.Cells(c1.Row, c1.Column).Interior.Color = RGB(255, 251, 204)
Sheet3.Cells(c1.Row, c1.Column).ClearComments
Sheet3.Cells(c1.Row, c1.Column).AddComment Sheet2.Cells(c1.Row, c1.Column).Text
Sheet3.Cells(c1.Row, c1.Column) = c1
Else
Sheet3.Cells(c1.Row, c1.Column).Interior.Color = RGB(255, 255, 255)
Sheet3.Cells(c1.Row, c1.Column).ClearComments
Sheet3.Cells(c1.Row, c1.Column) = c1
End If
Next c1
End Sub
No comments:
Post a Comment