• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Comparing two spreadsheets for changes

T

thereseexceljakubiak

New Member
Hi my Excel Heroes!!


So, I am in need of your super assistance again! :)


I update my files, on a daily basis and it would be very helpful to know of the changes that occur on those files. Can someone please help me with a macro to identify these changes?


*The number of columns and column names are always the same.

*The number of rows will always vary

*The type of data with in the cells are always the same (text, date, etc.)


* Some rows get added, deleted, updated


I have researched and found some codes but I need a code to find and match the unique ID# and then copy that row to the "Changes" tab but also to identify, whether its a #1:Change #2:Deletion #3:Addition


:)

I am attaching a sample Book1. Thank you for your help!


https://dl.dropboxusercontent.com/u/35552808/SAMPLE_chandoo_COMPARE.xls
 
Last edited by a moderator:
Hi, therese!


Give a look at this file:

https://dl.dropboxusercontent.com/u...r changes - (for therese at chandoo.org).xlsm

This is the code:

-----
Code: 
Option Explicit

Sub CompareSheets()
'
' constants
' worksheets & ranges
' original
Const ksWSOriginal = "ORIGINAL"
Const ksOriginal = "OriginalTable"
Const ksOriginalKey = "OriginalKey"
' updated
Const ksWSUpdated = "UPDATED"
Const ksUpdated = "UpdatedTable"
Const ksUpdatedKey = "UpdatedKey"
' changes
Const ksWSChanges = "CHANGES"
Const ksChanges = "ChangesTable"
' labels
Const ksChange = "CHANGE"
Const ksRemove = "REMOVE"
Const ksAdd = "ADD"
'
' declarations
Dim rngO As Range, rngOK As Range, rngU As Range, rngUK As Range, rngC As Range
Dim c As Range
Dim I As Long, J As Long, lChanges As Long, lRow As Long, bEqual As Boolean
'
' start
Set rngO = Worksheets(ksWSOriginal).Range(ksOriginal)
Set rngOK = Worksheets(ksWSOriginal).Range(ksOriginalKey)
Set rngU = Worksheets(ksWSUpdated).Range(ksUpdated)
Set rngUK = Worksheets(ksWSUpdated).Range(ksUpdatedKey)
Set rngC = Worksheets(ksWSChanges).Range(ksChanges)
With rngC
    If .Rows.Count > 1 Then
        Range(.Rows(2), .Rows(.Rows.Count)).ClearContents
        Range(.Rows(2), .Rows(.Rows.Count)).Font.ColorIndex = xlColorIndexAutomatic
        Range(.Rows(2), .Rows(.Rows.Count)).Font.Bold = False
    End If
End With
'
' process
lChanges = 1
' 1st pass: updates & deletions
With rngOK
    For I = 1 To .Rows.Count
        Set c = rngUK.Find(.Cells(I, 1).Value, , xlValues, xlWhole)
        If c Is Nothing Then
            ' deletion
            lChanges = lChanges + 1
            rngC.Cells(lChanges, 1).Value = ksRemove
            For J = 1 To rngO.Columns.Count
                rngC.Cells(lChanges, J + 1).Value = rngO.Cells(I, J).Value
                rngC.Cells(lChanges, J + 1).Font.Color = vbRed
                rngC.Cells(lChanges, J + 1).Font.Bold = True
            Next J
        Else
            bEqual = True
            lRow = c.Row - rngUK.Row + 1
            For J = 1 To rngO.Columns.Count
                If rngO.Cells(I, J).Value <> rngU.Cells(lRow, J).Value Then
                    bEqual = False
                    Exit For
                End If
            Next J
            If Not bEqual Then
                ' change
                lChanges = lChanges + 1
                rngC.Cells(lChanges, 1).Value = ksChange
                For J = 1 To rngO.Columns.Count
                    If rngO.Cells(I, J).Value = rngU.Cells(lRow, J).Value Then
                        rngC.Cells(lChanges, J + 1).Value = rngO.Cells(I, J).Value
                    Else
                        rngC.Cells(lChanges, J + 1).Value = rngU.Cells(I, J).Value
                        rngC.Cells(lChanges, J + 1).Font.Color = vbMagenta
                        rngC.Cells(lChanges, J + 1).Font.Bold = True
                    End If
                Next J
            End If
        End If
    Next I
End With
' 2nd pass: additions
With rngUK
    For I = 1 To .Rows.Count
        Set c = rngOK.Find(.Cells(I, 1).Value, , xlValues, xlWhole)
        If c Is Nothing Then
            ' addition
            lChanges = lChanges + 1
            rngC.Cells(lChanges, 1).Value = ksAdd
            For J = 1 To rngU.Columns.Count
                rngC.Cells(lChanges, J + 1).Value = rngU.Cells(I, J).Value
                rngC.Cells(lChanges, J + 1).Font.Color = vbBlue
                rngC.Cells(lChanges, J + 1).Font.Bold = True
            Next J
        End If
    Next I
End With
'
' end
Worksheets(ksWSChanges).Activate
rngC.Cells(2, 3).Select
Set rngC = Nothing
Set rngUK = Nothing
Set rngU = Nothing
Set rngOK = Nothing
Set rngO = Nothing
Beep
'
End Sub

-----


Just advise if any issue.


Regards!
 
Last edited by a moderator:
You- SirJB7- are truly my SuperHero!


I am sorry, I just got back to this site, today.


I tested it with my file....it works amazingly!!!! :)


Thank you so very much!
 
Hi, therese!

Glad you solved it. Thanks for your feedback and for your kind words too. And welcome back whenever needed or wanted.

Regards!
 
Hi SirJB7...

I've copied this code into excel and renamed the tabs to "Oringinal" and Updated" but I get an error "1004; Application-defined or object-defined error". I'm not good enough to modify this code (understanding the worksheet requirements etc.) but I'd like to use this type of code in a similar manner...with perhaps an additional nuance. Can this code be modified to find changes in fill and font color, including simple bolding?

I gave a good-sized report to my boss and he did a fabulous job of coding the document but most compare modules do not go past text differences. Is it possible to make this module "generic" in sheet naming requirements (or explain the sheet names if they they really need a defined range) and add some code that would recognize cell color differences?

P.S. the original attached sample file is no longer available for download ;-)

Forever grateful,

Jan :)
 
Hello Sir JB7:

I have just tried this code and it works perfect except for data type "DATE". If dates in 2 sheets are same then no issues but if their is a date change then it spits out altogether a new date(neither from original nor updated). Can you please check and advise.

Thank you

Jaini
 
Hi Jaini ,

The person whom you have addressed your question to , has not been active on this forum for the past 6 months ; can you start a new thread , and explain your question in more detail ? If you wish , you can link to this thread , so that who ever is interested to reply will have the complete background.

Narayan
 
Hi,

I have used the above code which works (almost) brilliantly!

The only problem I have is that my "Key" contains duplicates (I am using it to compare Sales Reports, the key is the Order Number which may have multiple lines)

At the moment, the code looks for the first instance of the number in the key, and returns all following instances as a "CHANGE". this may not be the case however.

Can anyone help me with an amendment to look for the next occurrence of the "Key" and compare those? Will I need to add a field to separate these (eg order 123 line 1, line 2 etc)

Any help would be much appreciated as I am so close to getting this perfect!
 
SirJB7 said:
Hi, therese!

Give a look at this file:

https://dl.dropboxusercontent.com/u/60558749/Comparing two spreadsheets for changes - (for therese at chandoo.org).xlsm
Click to expand...

There is an error in the extract below from the first listing.

Code: 
 rngC.Cells(lChanges, J +1).Value = rngU.Cells(I, J).Value

should be:

Code: 
 rngC.Cells(lChanges, J +1).Value = rngU.Cells(lRow, J).Value

As "I" refers to the row position in the "Original" file while "lRow" refers to the matching entry row position in the "Update" file.

Code: 
For J =1To rngO.Columns.Count
   If rngO.Cells(I, J).Value = rngU.Cells(lRow, J).Value Then
      rngC.Cells(lChanges, J +1).Value = rngO.Cells(I, J).Value
   Else
      rngC.Cells(lChanges, J +1).Value = rngU.Cells(I, J).Value
      rngC.Cells(lChanges, J +1).Font.Color = vbMagenta
      rngC.Cells(lChanges, J +1).Font.Bold =True
   EndIf
Next J
 
Hi SirJB7...

Have you had a chance to resolve the issue jlhalliday1reported. I am having same issue with the code, if I copy the code to a new excel 2010 file and rename the work as as Original, Updated and Changes or if I change the worksheet names on the macro, either way I am getting "1004; Application-defined or object-defined error and the code stops at the first set statement “Set rngO = Worksheets(ksWSOriginal).Range(ksOriginal)”

Is there any prerequisite to use the code? The code works fine, if run from the sample file attached with code on this site, but if we delete any rows from either worksheets from the sample file and try to run the code it will give the same error

"1004; Application-defined or object-defined error and the code stops at the first set statement “Set rngO = Worksheets(ksWSOriginal).Range(ksOriginal)”

This is a very useful code if it could works on any new file. I am using Excel2010.

what is the significance of "UpdatedTable" variable? is it just a constant name?
 
There are some real excel experts on this forum, delighted be part of it

I have amended above code but I want little modification/help with it

I want ADD/REMOVE and CHANGE to appear on separate sheets , currently, they are appearing in CHANGES sheet

Can anyone help me in modifying the code? (I have attached code file)
 

Attachments

  • Compare data Code VBA.docx
    14.6 KB · Views: 81
Good day Parshany and welcome to the forum

You have posted you question in an old thread, some of those who took part in answering the original question are no longer active.
You should start a new thread, no matter how similar your question may be, various reasons for this,

Those that have helped may not review this thread as they may be thinking that they can help no more.

Those who have viewed before but did not help may not view, even though they could have helped on this occasion.

Any help you do receive will not show in a search as your post is buried in another title.

All ways post anew, with a descriptive title to attract members, no matter how similar a question may be, this will get you the best possible help.


.
 
This file is unavailable please provide the file

thereseexceljakubiak said:
Hi my Excel Heroes!!


So, I am in need of your super assistance again! :)


I update my files, on a daily basis and it would be very helpful to know of the changes that occur on those files. Can someone please help me with a macro to identify these changes?


*The number of columns and column names are always the same.

*The number of rows will always vary

*The type of data with in the cells are always the same (text, date, etc.)


* Some rows get added, deleted, updated


I have researched and found some codes but I need a code to find and match the unique ID# and then copy that row to the "Changes" tab but also to identify, whether its a #1:Change #2:Deletion #3:Addition


:)

I am attaching a sample Book1. Thank you for your help!


https://dl.dropboxusercontent.com/u/35552808/SAMPLE_chandoo_COMPARE.xls
Click to expand...
 
The dropbox link is now stale but #3 above contains the source code in-line and #10 contains the correction for an error that was present. The macro could be assigned to a key using Alt-F8 and 'Options'

The constants refer to named ranges that contain the names of the worksheets containing the tables of records to be compared, the tables within those worksheets, and the keys in those records that are used for comparison (plus the labels to be used to highlight what has changed (record changed, added or removed).
 
You must log in or register to reply here.
Back
Top