How to compare two excel files using Macros in Excel

Question

I have picked up codes from stackoverflow and wanted to develop a macro for comparing two excel workbooks with multiple sheets and highlight the cell values that are different.

I am able to create new sheets but I am unable to copy and highlight the changed data into separate excel sheets.

The current code copies and highlights the differences but does it all in one single sheet overwriting the previous copied and highlighted data.

Private Sub CommandButton1_Click()

Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
Set wbkA = Workbooks.Open(Filename:="C:\macrotest\201566-15-00-DSEM-002-APP01.xlsm")
Set wbkB = Workbooks.Open(Filename:="C:\macrotest\testxl.xlsm")

For i = 1 To wbkA.Sheets.Count


Set varSheetA = wbkA.Worksheets(wbkA.Sheets(i).Name) 
Set varSheetB = wbkB.Worksheets(wbkB.Sheets(i).Name)
ThisWorkbook.Worksheets.Add().Name = wbkA.Sheets(i).Name
Sheets(i).Select

strRangeToCheck = "A1:DZ200"

Debug.Print Now
varSheetA = varSheetA.Range(strRangeToCheck)
varSheetB = varSheetB.Range(strRangeToCheck)
Debug.Print Now

For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
    For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
        If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
            Cells(iRow, iCol) = varSheetA(iRow, iCol)
        Else
            Cells(iRow, iCol) = varSheetA(iRow, iCol)
            Cells(iRow, iCol).Interior.Color = RGB(255, 0, 0)
        End If
    Next
Next
Next i
End Sub

Answer 1

Here's a bit of experimentation I did with this code (it has not been compiled and run)

I wanted to write this to show a method that could be used to improve the speed and to point out that the varSheetA and varSheetB variables do not refer to the cells on a sheet but actually store a copy of the values from cells in a sheet in an array variable in memory.

I have added a new array named varNewValues which I use to manipulate the new values that are to be shown to users on the new sheet. Using arrays is quicker than processing cells, so the code no longer sets the value of an individual cell in the loop.

I have added #HARVEY near new lines

Let me know what you think.

Private Sub CommandButton1_Click()

    ' #HARVEY
    Dim varNewValues as variant 
    Dim Destination As Range

    ' Note that these are used as arrays that store the sheet's cells in memory
    Dim varSheetA As Variant
    Dim varSheetB As Variant

    Dim strRangeToCheck As String
    Dim iRow As Long
    Dim iCol As Long
    Set wbkA = Workbooks.Open(Filename:="C:\macrotest\201566-15-00-DSEM-002-APP01.xlsm")
    Set wbkB = Workbooks.Open(Filename:="C:\macrotest\testxl.xlsm")

    For Each wshA In wbkA.Worksheets

        Set varSheetB = wbkB.Worksheets(wshA.Name)

        Set wshC = wbkB.Worksheets.Add()
        wshC.Name = wshA.Name

        strRangeToCheck = "A1:DZ200"

        Debug.Print Now
        varSheetA = wbkA.Range(strRangeToCheck)
        varSheetB = wbkA.Range(strRangeToCheck)

        ' #HARVEY
        varNewValues = varSheetA

        Debug.Print Now

        For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
            For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
                If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then

                    ' #HARVEY
                    ' Do nothing as the value from wbkA  is already the varNewValues array              

                Else

                    ' #HARVEY
                    ' Add both cell values to the new sheet's array                 
                    varNewValues(iRow, iCol) = varSheetA(iRow, iCol) & ":" & varSheetB(iRow, iCol)

                    wshC.Cells(iRow, iCol).Interior.Color = RGB(255, 0, 0)
                End If
            Next
        Next

    Next 


    ' #HARVEY
    ' Copy the array value to the  wshC range
    Set Destination = wshC.Range("A1")

    Destination.Resize(UBound(varNewValues, 1), UBound(varNewValues, 2)).Value = varNewValues

End Sub

Answer 2

Microsoft have developed a utility to do this see here

If you have access to Excel 2013 through Microsoft Office Professional Plus 2013 or through selected Office 365 subscription plans, you have access to a terrific new feature in Excel that allows you to electronically compare two workbooks and identify any differences in those workbooks. This new feature – Compare Files – is very powerful and, is very easy to use.

Note that the INQUIRE tab on the ribbon is only shown if you enable the COM addin that has the same name.

Incidentally, if you want to compare the VBA code for Access project use OASIS-SVN to export the code (and other objects defs.) then use git .

(I appreciate you might need to write your own code!, but in case a tool would help you this is worth knowing about. Also, perhaps for debugging?)

Answer 3

I think your best answer would be to create a new sheet listing the changes, preferably in a new workbook.

Next, you should use an object variable of type Excel.Worksheet and iterate through the sheets in your workbook:

Iterating through each worksheet in an Excel workbook using VBA

Dim wbkA As Excel.Workbook
Dim wshA As Excel.Worksheet

Dim wbkB As Excel.Workbook
Dim wshB As Excel.Worksheet

Dim wbkC As Excel.Workbook
Dim wshC As Excel.Worksheet

Set wbkC = Workbooks.Add
    wbkC.SaveAs "C:\macrotest\Changes.xlsx"
 
For Each wshA In wbkA.Worksheets

    Set wshB = wbkB.Worksheets(wshA.Name)
    ' you will raise an error if no sheet of this name exists in B
 
    Set wshC = wbkB.Worksheets.Add()
        wshC.Name = wshA.Name

'    **** Implement your value-checking loop here ****
'    wshC.Cells(iRow, iCol) = varSheetA(iRow, iCol)

Next wshA 

I'll leave you to fill in your value capture logic and the comparison loop: and I note that you are using an efficient data capture method when you lift a range of cells into an array in a single call to each sheet, and iterate the array.

The most efficient output method is to write an array to the sheet in a single 'hit'; however, the need to format the target sheet cell-by-cell erodes the performance gain.

[Edited: additional material by request]

As a footnote, you can remove unwanted sheets with this snippet of VBA:

wbkC.Worksheets("Sheet1").Delete

However, this code comes with a warning: the sheet names will differ from 'Sheet1' etc in international versions of MS-Office. And it would be an embarrassing thing to do if one of the sheets in the workbook under examination was called 'Sheet2'.

You could try deleting sheets by ordinal wbkC.Worksheets(1).Delete : wbkC.Worksheets(2).Delete and so on: but that could be embarrassing if the ordinals aren't where you expect them to be after running the comparison and creating new sheets...

I'll let you look for practical examples of unexpected behaviours in object container ordinals.

...So the answer is to delete the sheets in wbkC before the operations on workbooks 'A' and 'B'. There are some arcane points of defensive coding to this:

Application.DisplayAlerts = False  ' Suppress warning messages
For i = wbkC.Worksheets.Count to 2 Step -1
    wbkC.Worksheets(i).Delete
Next i

You can't delete the last sheet: my advice would be to make a virtue of necessity and rename it 'Control' or 'Audit' and use it to write the names of files 'A' and 'B' with the user name and a timestamp.

And you are, of course, dismissing objects and erasing the arrays on exit.

Answer 4

The new sheets are added to the front, so the problem could be solved by forcing them to be added to the end, and then selecting the last sheet:

Worksheets.Add(After:=Sheets(Sheets.Count)).Name = wbkA.Sheets(i).Name
Sheets(Sheets.Count).Select

Also, "ThisWorkbook.Activate" should be added before the initial loop to make sure this code is taking place in the right workbook:

ThisWorkbook.Activate
For i = 1 To wbkA.Sheets.Count