Thread: track of changes between two workbooks.

What I want a VBA script to do (and there is a method to this madness, so it must be done this way):

Note: I started off my macro by creating a list and sorting the REFERENCE workbook and PULLED workbook from least to greatest from column A2 (column A1 contained the title of the lists).

I will refer to the reference workbook as “Book1” and the pulled workbook as “Book2” to help make my sentence a little less confusing than it already is.

I want Book2 to compare the rows from column A2 through to the end of its list in column A with Book1’s rows in column A2 to the end of its list in column A. If Book2 has new data in column A that Book1 does not have, then type the letter “N” in column B of Book2 of those same rows (that have the new data in column A) for each row with new data. Also, if Book1 has old data in any rows from Column A2 through to the end of its list that Book2 does not have, then I want that data to be copied and inserted into the end of the list in Column A of Book2. Then type the letter “O” in column B of Book2 of that same row where that copied data was inserted into column A of Book2.

When the Macro is done, Book2 should have a “N” in column B in every row where new data was reported in Column A that Book1 did not previously have. Book2 should also have the letter “O” in column B in every row where old data from Book1 was copied and pasted into Book2 column A at the end of the list.

Here’s an example:

Book1 (old reference data)

1A_Phone Number
2A_1-111-1111
3A_1-222-2222
4A_1-333-3333
5A_1-444-4444
6A_1-555-5555
7A_1-666-6666
8A_1-777-7777

Book2 (new pulled data)

1A_Phone Number
2A_1-111-1111
3A_1-333-3333
4A_1-444-4444
5A_1-555-5555
6A_1-777-7777
7A_1-888-8888


Book2 (After the macro)

1A_Phone Number__1B_Change
2A_1-111-1111_____2B_
3A_1-333-3333_____3B_
4A_1-444-4444_____4B_
5A_1-555-5555_____5B_
6A_1-777-7777_____6B_
7A_1-888-8888_____7B_N
8A_1-222-2222_____8B_O
9A_1-666-6666_____9B_O


Thanks in advance.

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.
To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

Edit: Title altered, please read the Forum Rules before posting again

Hi, Try this:- I ran this from "Book2", but should not Matter.
Note the results will be in Column "C" "Book2". To overwrite Column "A" "Book2" with results, alter Range address in 3rd from last line in code.

Sub MG01Aug16
Dim Rng2 As Range

Dim Rng1 As Range

Dim Ray As Variant

Dim R As Long
Dim Rr As Long
Dim iR As String

With Workbooks("Book2.xls").Sheets("Sheet1")
    Set Rng2 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
End With

With Workbooks("Book1.xls").Sheets("Sheet1")
    Set Rng1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
End With

Ray = Array(Rng2.Value, Rng1.Value)

With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    For R = 0 To UBound(Ray)
        For Rr = 1 To UBound(Ray(R))
            If Not .Exists(Ray(R)(Rr, 1)) Then
                iR = IIf(R = 0, "N", "O")
                .Add Ray(R)(Rr, 1), iR
            Else
                .Item(Ray(R)(Rr, 1)) = IIf(.Item(Ray(R)(Rr, 1)) = "N", "", "O")
            End If
        Next Rr
    Next R

Workbooks("Book2.xls").Sheets("Sheet1") _
    .Range("C2").Resize(.Count, 2) = _
        Application.Transpose(Array(.Keys, .items))

End With

End Sub

Regards Mick

Hi 4EverLearning

Welcome to the forum

I had this written just as Roy posted.

I held it back until now because of Forum rules.

Sub CompoundListings()
    Dim LastRowWS1 As Long, LastRowWS2 As Long, NextRowWS2 As Long
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    
    Set wb1 = Workbooks("Book1.xls")
    Set wb2 = Workbooks("Book2.xls")
    
    Set ws1 = wb1.Sheets("Sheet1")
    Set ws2 = wb2.Sheets("Sheet1")
    
    LastRowWS1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    LastRowWS2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    NextRowWS2 = LastRowWS2 + 1
    
    With ws2
        .Range("B1") = "Change"
        .Range("B2").Formula = "=IF(ISNA(MATCH(A2,[" & wb1.Name & "]Sheet1!A:A,0))," & """N""" & ","""")"
        With .Range("B2:B" & LastRowWS2)
            .FillDown
            .Copy
            .PasteSpecial Paste:=xlPasteValues
        End With
    End With
    Application.CutCopyMode = False
    With ws1
        .Range("B2").Formula = "=IF(ISNA(MATCH(A2,[" & wb2.Name & "]Sheet1!A:A,0))," & """O""" & ","""")"
        .Range("B2:B" & LastRowWS1).FillDown
    
        .Columns("A:B").AutoFilter
        .Range("$A$1:$B$" & LastRowWS1).AutoFilter Field:=2, Criteria1:="<>"
        .Range("$A$2:$B$" & LastRowWS1).Copy
        ws2.Range("A" & NextRowWS2).PasteSpecial Paste:=xlPasteValues, _
                        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
        Application.CutCopyMode = False
        .Columns.AutoFilter
        .Range("B:B").Clear
    End With
    
    Set wb1 = Nothing
    Set wb2 = Nothing
End Sub

Hope this helps

One more thing MickG ... So far this formula puts a "N" if the phone numbers are new and an "O" if they are old when it creates the list.

But now I want to add a "S" if the phone numbers are the same. How do I do that?