Compare Two workbooks

Hi Akulka,

What does your data look like and is it the same field by field and are there key fields? and,and ....

Can you post a couple of sample spreadsheets?

Attach a sample workbook. Make sure there is just enough data to make it clear what is needed. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are demonstrated, mock them up manually if needed. Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

Hi Akulka,

Must the routine search for these tables or are they always in the same place?

This works with your sample data:

Sub Akulka(): Dim wt As Workbook, wy As Workbook, WO As Workbook
Dim wtd As Worksheet, wyd As Worksheet, wod As Worksheet
Dim r As Long, c As Long, lr As Long, lc As Long, i As Long, j As Long
Dim T As String, Y As String, n As Integer, k As Long, WI, WF As Object
WI = Array(" ", "DATA1", "DATA2", "DATA3"): lr = 1: lc = 1: r = 1: c = 1
        'Did you want to skip weekends and holidays?
T = Replace(CStr(Date), "/", ""): Y = Replace(CStr(Date - 1), "/", "")
Set wt = Workbooks(T & ".xlsx"): Set wy = Workbooks(Y & ".xlsx")
    Set WO = Workbooks("Output.xlsx"): Set WF = WorksheetFunction
            For n = 1 To wt.Worksheets.count: WI = "DATA" & n
        Set wtd = wt.Worksheets(WI): Set wyd = wy.Worksheets(WI)
                Set wod = WO.Worksheets("diff" & WI)
GetTableLimits: Do Until WF.CountA(wtd.Columns(c)) <> 0: c = c + 1
                    If c >= Columns.count Then
                    GoTo GetAnother: End If
                Loop
                Do Until WF.CountA(wtd.Rows(r)) <> 0: r = r + 1: Loop
                lr = r: Do Until WF.CountA(wtd.Rows(lr + 1)) = 0: lr = lr + 1: Loop
                lc = c: Do Until WF.CountA(wtd.Columns(lc + 1)) = 0: lc = lc + 1: Loop
                For j = r + 1 To lr: For i = c + 1 To lc
                If wtd.Cells(j, i) <> wyd.Cells(j, i) Then
            k = k + 1: wtd.Range(wtd.Cells(j, c), wtd.Cells(j, lc)).Copy wod.Cells(k, 1)
        wod.Cells(k, lc - c + 2) = wt.Name: wod.Cells(k, lc - c + 3) = "Row" & j
                k = k + 1: wyd.Range(wyd.Cells(j, c), wyd.Cells(j, lc)).Copy wod.Cells(k, 1)
        wod.Cells(k, lc - c + 2) = wy.Name: wod.Cells(k, lc - c + 3) = "Row" & j
                k = k + 2: GoTo GetNext: End If: Next i
GetNext:                 Next j
                c = lc + 3: GoTo GetTableLimits
GetAnother: c = 1: lc = 1: r = 1: lr = 1: k = 0: Next n
End Sub

This the main challenge because for each report table places are changed.

I am getting error on Set wt = Workbooks(T & ".xlsx")

Hi Akulka,

You need the set up that you sent me i.e.
Today's Book, Yesterday's Book and a Book named Output


Copy the code to the clipboard
In the Book named Output
Press ALT + F11 to open the Visual Basic Editor.
Select Module from the Insert menu
Type "Option Explicit" then paste the code into the white space on the right.

With the cursor between Sub and End Sub press F5 OR

Press ALT + Q to close the code window.
Press ALT + F8 then double click on the macroname (Akulka)

Hi Akulka,

Do you need instructions on how to run it?

Oh - I forgot to tell you to save the Workbook as Macro-Enabled - sorry

I am getting error on Set wt = Workbooks(T & ".xlsx")

If it's a subscript error then you don't have a book named 2152014.xlsx??

I'll look into the GetOpenFilename option - but, it won't be today.

Maybe another forum contributor can help you?

And, thanks for the rep!

Hi Akulka,

My plans fell through - try this and let me know of the next issue

Sub Akulka2(): Dim wt As Workbook, wy As Workbook, wo As Workbook
Dim wtd As Worksheet, wyd As Worksheet, wod As Worksheet, FNT As String, FNY As String
Dim r As Long, c As Long, lr As Long, lc As Long, i As Long, j As Long, WI As String
Dim T As String, Y As String, n As Integer, k As Long, WF As Object
lr = 1: lc = 1: r = 1: c = 1   'Did you want to skip weekends and holidays?
n = Val(InputBox("How many days ago is the latest comparison file - 0,1,2,3 etc?"))
T = Replace(CStr(Date - n), "/", ""): Y = Replace(CStr(Date - n - 1), "/", "")
GetFiles: If n > 10 Then Exit Sub
FNT = Application.GetOpenFilename: FNY = Application.GetOpenFilename
VerifyFiles:
        If InStr(1, FNT, T) And InStr(1, FNY, Y) = 0 Then
        n = n + 1: GoTo GetFiles: End If
Workbooks.Open FNT: Set wt = ActiveWorkbook: Workbooks.Open FNY: Set wy = ActiveWorkbook
     Set wo = Workbooks("Output.xlsx"): wo.Activate: Set WF = WorksheetFunction
            For n = 1 To wt.Worksheets.Count: WI = wt.Sheets(n).Name
        Set wtd = wt.Worksheets(WI): Set wyd = wy.Worksheets(WI)
                    For Each wod In wo.Worksheets
        If wod.Name = ("diff" & WI) Then GoTo Setwod
                    Next
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "diff" & WI
Setwod:                Set wod = wo.Worksheets("diff" & WI)
GetTableLimits: Do Until WF.CountA(wtd.Columns(c)) <> 0: c = c + 1
                    If c >= Columns.Count Then
                    GoTo GetAnother: End If
                Loop
                Do Until WF.CountA(wtd.Rows(r)) <> 0: r = r + 1: Loop
                lr = r: Do Until WF.CountA(wtd.Rows(lr + 1)) = 0: lr = lr + 1: Loop
                lc = c: Do Until WF.CountA(wtd.Columns(lc + 1)) = 0: lc = lc + 1: Loop
                For j = r + 1 To lr: For i = c + 1 To lc
                If wtd.Cells(j, i) <> wyd.Cells(j, i) Then
            k = k + 1: wtd.Range(wtd.Cells(j, c), wtd.Cells(j, lc)).Copy
            wod.Cells(k, 1).PasteSpecial xlPasteValues
        wod.Cells(k, lc - c + 2) = wt.Name: wod.Cells(k, lc - c + 3) = "Row" & j
            k = k + 1: wyd.Range(wyd.Cells(j, c), wyd.Cells(j, lc)).Copy
            wod.Cells(k, 1).PasteSpecial xlPasteValues
        wod.Cells(k, lc - c + 2) = wy.Name: wod.Cells(k, lc - c + 3) = "Row" & j
                k = k + 2: GoTo GetNext: End If: Next i
GetNext:                 Next j
                c = lc + 3: GoTo GetTableLimits
GetAnother: c = 1: lc = 1: r = 1: lr = 1: k = 0: Next n
End Sub