CODEWITHSUNDEEP
excelvba
Srpic
Srpic

Reputation: 450

VBA - Compare two sheets and results paste on new sheet

I have 2 sheets "2019 Project Detail" and "2019 Project Detail SOURCE", the structure is same, since "2019 Project Detail SOURCE" is a copy of "2019 Project Detail". Then I would like to check if there are any differences between these 2 sheets. If someone has changed any number / anything on sheet "2019 Project Detail". If so, then highlight them and also paste the reference of changed cell on 3rd sheet "Results" (i.e. "2019 Project Detail!AD4").

I have code that highlight the changes, but I can't figure out how to paste the changes on "Results" sheet.

Code:

Sub CompareAndHighlightDifferences()

Dim w1 As Worksheet, w2 As Worksheet, w3 As Worksheet

Set w1 = Sheets("2019 Project Detail")
Set w2 = Sheets("2019 Project Detail SOURCE")
Set w3 = Sheets("Results")

With w1
    For Each cel In .UsedRange
        If cel.Value <> w2.Cells(cel.Row, cel.Column).Value Then cel.Interior.Color = vbBlue

    Next cel
End With

End Sub

Could you advise me, please?

Many thanks!

Upvotes: 0

Views: 594

Answers (2)

FunThomas
FunThomas

Reputation: 29146

This piece of code will log all changes into w3:

Dim row As Long
row = 1

With w1
    For Each cel In .UsedRange
        If cel.Value <> w2.Cells(cel.row, cel.Column).Value Then
            cel.Interior.Color = vbBlue
            w3.Cells(row, 1) = cel.Address
            w3.Cells(row, 2) = cel.Value
            w3.Cells(row, 3) = w2.Cells(cel.row, cel.Column).Value
            row = row + 1
        End If
    Next cel
End With

Upvotes: 1

Sergey
Sergey

Reputation: 97

Probably, one of options will help to compare changes. Option 1 wil display values from both sheets in the same cell on "Results" worksheet. Option 2 can list names of different cells.

Sub CompareAndHighlightDifferences()
Dim w1 As Worksheet, w2 As Worksheet, w3 As Worksheet
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
Set w3 = Sheets("Sheet3")
For Each cel In w1.UsedRange
    If cel.Value <> w2.Cells(cel.Row, cel.Column).Value Then
        cel.Interior.Color = vbBlue
        'Option 1
        'w3.Cells(cel.Row, cel.Column).Value = w1.Name & " value: " & cel.Value & " / " & _
        'w2.Name & " value: " & w2.Cells(cel.Row, cel.Column).Value

        'Option 2
        lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
        w3.Cells(lLastRow + 1, 1).Value = Split(cel.Address(True, False), "$")(0) & cel.Row
    End If
Next cel
End Sub

Upvotes: 1

Related Questions