Tuesday, February 5, 2013

Compare Excel Spreadsheets

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