Best approach needed for comparing and logging changes

hoffdar

New Member
Joined
Sep 13, 2014
Messages
3
I am stumped... while not a newbie to Excel I am in unfamiliar territory with what I have been tasked to do.

I am using Excel 2007.

OK ... here is the setup:

I have a sheet (lets call it "Original") that has roughly 100 rows that gets refreshed daily and creates a copy of the data on a second sheet (lets call it "Update"). It is pretty standard, column A has unique IDs and there are several columns I need to compare that are dates.

What I need to do is write a macro that looks at each row of the "Original" sheet, looks at column C, compares is to column C in "Update" if there is a difference then it would log the unique ID, Title and both the original date and the changed date in a separate ChangeLog sheet. I will then need to loop back through several other times to check for the differences in the other columns. Each difference would be logged on a separate row in the ChangeLog. (For instance a single row from original might have many rows in the ChangeLog each day depending on what has changed.) It is a running log so it would never overwrite historical data.

I don't think it is too hard of a task... and I have seen some examples that do compares but do not log individual changes. Any help would be appreciated.


hoffdar
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
That explination was not specific enough to answer your quesion. You start your day with an original sheet and and update sheet. The update sheet looks exactly the same as your original sheet at this time. As the day progresses, users are changing and adding thing to the update sheet but not the original sheet. When you are ready to generate a Change Log Report at the end of the day, you run a macro to compare the differences. Each difference in each row and each coloumn is represented in a seperate row of the Change Log. Am I right so far in assuming that you will begin the day with an Original sheet and and Update sheet? So you only need a macro to create a Change Log right?

If I am right so far, then I can explain to you what you can do to accomplish this, but I don't have time to write it myself right now. I have to go to work. You will need to create to loops to accomplish this task. The first loop runs until the last row in the update sheet. The second loop goes in the first loop. The second loop runs until the last column in the current row that it is reviewing. You will need to figure out what the last row is in your Update sheet. Do this with lastRow = Sheets("Update").Range("A" & Rows.Count).End(xlup).Row
Then you can use this as criteria for your first loop so it knows when to exit the loop.
i = 2
Do Until i = lastRow
'Next loop goes here
i = i + 1
Loop

Inside the first loop, you'll need to figure out what the last column with data is that is currently being evaluated. I don't have that code memorized so you'll have to google it. Search for something like "last column with text in a row excel vba". Then you can put it in a variable such as lastColumn = 'the code
Then make your next loop
lastColumn = 'the code
x = 2
Do Until x = lastColumn
'the analyze code
x = x + 1
Loop

This is where it gets hard. You'll need to enter code that can do all of these things...
First if finds out what value is being evaluated. So if the current cell being evaluated has the value "12/12/2012", then it needs to be put in a variable.
Then you need code that can check if that date is in any cell in the current row being evaluated. So you will need a third loop that is exactly coded like the second loop you created only don't use x as the counter this time. Use another variable like c.
A problem i can forsee is if you ever have the same date in more than one cell on the same row. Will that ever happen. If it can happen, then your code will become quite complicated. I suggest we skip that for now and work on the foundation of the code first, then go back to that later.
So if the current cell matches any date of row being evaluated, then it will consider it a match and not do anything. If there is no match, then it will output the ID and date into the next row of the change log.
It's a little complicated I know. You think dealing with nested if statements is confusing. Wait until you've coded your first nested loops. You are more than likely going to need help to accomplish this horrific task and I will be able to help you on Monday. I will need you to understand everything I said thus far so you can tell me if I'm right about all of my assumptions before I begin coding. I don't want to make this horrific program if it isn't even exactly what you wanted.
 
Upvote 0
WarPiglet.... I apologize for not being more clear... but your assumptions are for the most part right on.

Basically each morning I need to run this compare and report out the changes from the previous day in the ChangeLog. The "Original" from the previous run is trashed and the Update becomes the Original (that is something I can take care of). So yes, I need to do the compare each day and create a ChangeLog. While the data will have 5 date columns to compare I gave an example below using just 3 date columns.

Original
UniqueIDTitleDateADateBDateC
123456ablah12/1/2014 12/15/2014 12/24/2014
123457bblah12/1/201412/15/201412/24/2014
123458 cblah12/1/201412/15/201412/24/2014
123459dblah12/1/201412/15/201412/24/2014

<tbody>
</tbody>

Updated
UniqueIDTitleDateADateBDateC
123456ablah12/1/201412/15/201412/24/2014
123457bblah12/2/201412/15/201412/24/2014
123458cblah12/1/201412/15/201412/24/2014
123459dblah12/1/201412/20/201412/27/2014

<tbody>
</tbody>


Change Log
UniqueIDTitleDateA(Original)DateA(Updated)DateB(Original)DateB(Updated)DateC(Original)DateC(Updated)
123457bblah12/1/201412/2/2014
123459dblah12/15/201412/20/2014
123459dblah12/24/201412/27/2014

<tbody>
</tbody>




You are again correct in the second to last paragraph. It is not very likely that the value could be duplicated in the evaluated row but it could happen. (As you suggested we can skip it for now.)

Thanks for your help.


hoffdar
 
Upvote 0
You haven't written back yet. I'll get you started on it, but I can't finish the code until you reply to my last message.
Code:
sht1 = "Original"
sht2 = "Update"
sht3 = "ChangeLog
lastRow = Sheets(sht1).Range("A" & Rows.Count).End(xlup).Row
i = 2  'If you don't have headers in your Original and Update sheets, i = 1
If Sheets(sht3).Range("A2").value <> "" Then  'Change A2 to A1 if you do not have headers in your Change Log sheet.
     c = Sheets(sht3).Range("A" & Rows.Count).End(xlup).Row
Else
     c = 2  'If you don't have headers in your ChangeFile, c = 1
End If
Do Until i > lastRow
     If Sheets(sht1).Range("C" & i).value <> _
          Sheets(sht2).Range("C" & i).value Then
          Sheets(sht3).Range("A" & c).value = Sheets(sht1).Range("A" & i).value
          Sheets(sht3).Range("B" & c).value = Sheets(sht1).Range("B" & i).value
          Sheets(sht3).Range("C" & c).value = Sheets(sht1).Range("C" & i).value
          Sheets(sht3).Range("D" & c).value = Sheets(sht2).Range("C" & i).value
          c = c + 1
     End If
i = i + 1
Loop
 
Upvote 0
Awesome. Now that I have seen what your output should look like, I can get to work. And I have good news. Since you explained it better this time, I was able to determine that this is going to be easier than I originally explained. I was originally under the impression that each change would have it's own row in the change sheet. But in your new example output, that is not what you explained. Using your new dataset, here is the code.
Code:
[COLOR=#333333]sht1 = "Original"[/COLOR]
sht2 = "Update"
sht3 = "ChangeLog
lastRow = Sheets(sht2).Range("A" & Rows.Count).End(xlup).Row
i = 2 'If you don't have headers in your Original and Update sheets, i = 1
If Sheets(sht3).Range("A2").value <> "" Then  'Change A2 to A1 if you do not have headers in your Change Log sheet.     
     c = Sheets(sht3).Range("A" & Rows.Count).End(xlup).Row
Else
     c = 2  'If you don't have headers in your Change sheet, c = 1
End If
Do Until i > lastRow
     If Sheets(sht1).Range("C" & i).value <> _ 
         Sheets(sht2).Range("C" & i).value OR _
         Sheets(sht1).Range("D" & i).value <> _
         Sheets(sht2).Range("D" & i).value OR _
         Sheets(sht1).Range("E" & i).value <> _
         Sheets(sht2).Range("E" & i).value Then
          Sheets(sht3).Range("A" & c).value = Sheets(sht1).Range("A" & i).value
          Sheets(sht3).Range("B" & c).value = Sheets(sht1).Range("B" & i).value
         If Sheets(sht1).Range("C" & i).value <> _
              Sheets(sht2).Range("C" & i).value Then
              Sheets(sht3).Range("C" & c).value = Sheets(sht1).Range("C" & i).value
              Sheets(sht3).Range("D" & c).value = Sheets(sht2).Range("C" & i).value
         End If
         If Sheets(sht1).Range("D" & i).value <> _
              Sheets(sht2).Range("D" & i).value Then
              Sheets(sht3).Range("E" & c).value = Sheets(sht1).Range("D" & i).value
              Sheets(sht3).Range("F" & c).value = Sheets(sht2).Range("D" & i).value
         End If
         If Sheets(sht1).Range("E" & i).value <> _
              Sheets(sht2).Range("E" & i).value Then
              Sheets(sht3).Range("G" & c).value = Sheets(sht1).Range("E" & i).value
              Sheets(sht3).Range("H" & c).value = Sheets(sht1).Range("E" & i).value
         End If
          c = c + 1
     End If
i = i + 1
 [COLOR=#333333]Loop
[/COLOR]
 
Last edited:
Upvote 0
Try this:-
Your data in sheet "Original & "Update", Results in sheet "ChangeLog"
Code:
[COLOR=Navy]Sub[/COLOR] MG14Sep52
[COLOR=Navy]Dim[/COLOR] oRng            [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn              [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n               [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] uRng            [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Shts            [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Q               [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] P               [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Dic             [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]With[/COLOR] Sheets("Original")
    [COLOR=Navy]Set[/COLOR] oRng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]With[/COLOR] Sheets("Update")
    [COLOR=Navy]Set[/COLOR] uRng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Shts = Array(oRng, uRng)
[COLOR=Navy]For[/COLOR] n = 0 To 1
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Shts(n)
        [COLOR=Navy]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
            Dic.Add Dn.Value, Array(Dn, Nothing)
        [COLOR=Navy]Else[/COLOR]
            Q = Dic.Item(Dn.Value)
            [COLOR=Navy]If[/COLOR] n = 1 [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]Set[/COLOR] Q(1) = Dn
            [COLOR=Navy]End[/COLOR] If
            Dic.Item(Dn.Value) = Q
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]Dim[/COLOR] k           [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] c           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] y           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
ReDim ray(1 To Dic.Count, 1 To 10) '[COLOR=Green][B]NB:- Change to 10 for 5 (double) date columns[/B][/COLOR]


[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] k [COLOR=Navy]In[/COLOR] Dic.keys
     y = 2
     For P = 2 To 5 '[COLOR=Green][B] Nb:- change to "2 to 7", for 5 date columns[/B][/COLOR]
        y = y + 2
        [COLOR=Navy]If[/COLOR] Not Dic.Item(k)(0).Offset(, P) = Dic.Item(k)(1).Offset(, P) [COLOR=Navy]Then[/COLOR]
            c = c + 1
            ray(c, 1) = k: ray(c, 2) = Dic.Item(k)(0).Offset(, 1).Value
            ray(c, y - 1) = DateValue(Dic.Item(k)(0).Offset(, P).Value)
            ray(c, y) = DateValue(Dic.Item(k)(1).Offset(, P).Value)
            
       [COLOR=Navy]End[/COLOR] If
 [COLOR=Navy]Next[/COLOR] P
[COLOR=Navy]Next[/COLOR] k
[COLOR=Navy]Dim[/COLOR] Lst [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]With[/COLOR] Sheets("ChangeLog")
    .Range("A1").Resize(, 8).Value = Array("UniqueID", "Title", "DateA(Original)", "DateA(Updated)", "DateB(Original)", "DateB(Updated)", "DateC(Original)", "DateC(Updated)")
    Lst = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A" & Lst + 1).Resize(Dic.Count, 8) = ray '[COLOR=Green][B]NB:- Change from 8 to 10 for 10 final columns[/B][/COLOR]
[COLOR=Navy]End[/COLOR] With


[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
WarPiglet,

WOW.... that did the trick....It does exactly what was needed. I left out that I need to data stamp each row... but I think I can handle that. Thanks a ton, the code is extremely quick and easy to follow and I am sure I can use this to apply to other things I will need to do in the future.

Again, I really appreciate it... I was banging my head on my monitor for a couple of days trying to figure out how to get that done.


hoffdar
 
Upvote 0

Forum statistics

Threads
1,214,594
Messages
6,120,436
Members
448,964
Latest member
Danni317

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top