Hi all,
i'm trying to put together a code to help me spot changes between two worksheets which are in two different workbooks. The layout of the worksheets is the same but data may change, be added, removed.
i have put together the following code by browsing different forums but this is not helping me: what i would like is to see old and new values as per code below, but also the name of the field for which value changed(row 8) and the article which changed(column D). This would help me sorting out if the change is relevant or not. also it would help to understand if it's a Change(different value for same cell),Addition(new value, previously blank) or deletion(blank, previously populated).can anyone support me?
i'm trying to put together a code to help me spot changes between two worksheets which are in two different workbooks. The layout of the worksheets is the same but data may change, be added, removed.
i have put together the following code by browsing different forums but this is not helping me: what i would like is to see old and new values as per code below, but also the name of the field for which value changed(row 8) and the article which changed(column D). This would help me sorting out if the change is relevant or not. also it would help to understand if it's a Change(different value for same cell),Addition(new value, previously blank) or deletion(blank, previously populated).can anyone support me?
Code:
Sub DoCompare()
Dim WS As Worksheet
Workbooks.Add
For Each WS In Workbooks("1.xlsm").Worksheets
Call CompareWorkbooks(WS, Workbooks("2.xlsm").Worksheets(WS.Name))
Next
End Sub
Sub CompareWorkbooks(ByVal WS1 As Worksheet, _
ByVal WS2 As Worksheet)
Dim iRow As Integer
Dim iCol As Integer
Dim R1 As Range
Dim R2 As Range
Worksheets.Add.Name = WS1.Name ' new book for the results
Range("A1:E1").Value = Array("Address", "Difference", WS1.Parent.Name, WS2.Parent.Name, Field)
Range("A2").Select
For iRow = 1 To Application.Max(WS1.Range("A1").SpecialCells(xlLastCell).Row, _
WS2.Range("A1").SpecialCells(xlLastCell).Row)
For iCol = 1 To Application.Max(WS1.Range("A1").SpecialCells(xlLastCell).Column, _
WS2.Range("A1").SpecialCells(xlLastCell).Column)
Set R1 = WS1.Cells(iRow, iCol)
Set R2 = WS2.Cells(iRow, iCol)
' compare the types to avoid getting VBA type mismatch errors.
If TypeName(R1.Value) <> TypeName(R2.Value) Then
NoteError R1.Address, "Type", R1.Value, R2.Value
End If
Next iCol
Next iRow
With ActiveSheet.UsedRange.Columns
.AutoFit
.HorizontalAlignment = xlLeft
End With
End Sub
Sub NoteError(Address As String, What As String, V1, V2)
ActiveCell.Resize(1, 4).Value = Array(Address, What, V1, V2)
ActiveCell.Offset(1, 0).Select
If ActiveCell.Row = Rows.Count Then
MsgBox "Too many differences", vbExclamation
End
End If
End Sub
