Macro to compare and process lines in fixed file vs daily incoming file

S

sncb

Board Regular
Joined
Mar 17, 2011
Messages
168
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
I am trying to build a macro based excel tracker for my orders. I have an excel file called 'Tracker' that I maintain on my laptop and another file that i receive daily called 'OpenOrders'. The structure of the lines on both files are exactly the same.

In the 'Tracker 'file I have lines that show existing open orders. Then during the day yesterday some of the orders in the system would have closed and today I would have received the updated 'OpenOrders' file. Now in the newly arrived file today, orders that were closed yesterday would therefore no longer appear in the today's file while orders that are still open in the system will of course show up.

I would like to use a macro in the 'Tracker' file to look at the newly arrived file called 'OpenOrders' and

1. Compare the rows in the 'Tracker' file lines Sheet1 with the rows in the newly arrived OpenOrders file Sheet1

2. If the order lines in the Tracker file Sheet1 do not exist in the newly arrived 'OpenOrders' file Sheet1 (meaning they have been closed in the system) then those rows in the Tracker file Sheet1 should be moved to Sheet2

3. If order lines in the Tracker file Sheet1 exist in the newly arrived 'OpenOrders' file Sheet1 (meaning they are still open in the system) then the existing rows in 'Tracker' Sheet1 should remain as they are and new lines from 'OpenOrders' should be added to the 'Tracker' file Sheet1

4. The next day when the macro is run, same action as #2 and #3 but newly closed orders should be added to the last row on Tracker file Sheet2 so that i can maintain the list of all Closed orders.

Data in both files start from A1 as shown in the screenshots.

'Tracker' file as of yesterday evening:
Tracker.xlsx
ABCDEFGHIJ
1ColAColBColCCustOrdNoOrderNoColFLnNoColHProductColJ
2InfoInfoInfoOrd1IntOrd1Info1InfoProductAInfo
3InfoInfoInfoOrd2IntOrd2Info1InfoProductBInfo
4InfoInfoInfoOrd3IntOrd3Info1InfoProductCInfo
5InfoInfoInfoOrd4IntOrd4Info1InfoProductDInfo
6InfoInfoInfoOrd5IntOrd5Info1InfoProductEInfo
Sheet1


New arrived 'OpenOrders' file this morning: (Let's say ord2 and ord3 were closed yesterday)
OpenOrders.xlsx
ABCDEFGHIJ
1ColAColBColCCustOrdNoOrderNoColFLnNoColHProductColJ
2InfoInfoInfoOrd1IntOrd1Info1InfoProductAInfo
3InfoInfoInfoOrd4IntOrd4Info1InfoProductDInfo
4InfoInfoInfoOrd5IntOrd5Info1InfoProductEInfo
5InfoInfoInfoOrd6IntOrd6Info1InfoProductMInfo
6InfoInfoInfoOrd7IntOrd7Info1InfoProductDInfo
Sheet1


After running the Macro, the expected output in the 'Tracker' file Sheet 1:
Tracker.xlsx
ABCDEFGHIJ
1ColAColBColCCustOrdNoOrderNoColFLnNoColHProductColJ
2InfoInfoInfoOrd1IntOrd1Info1InfoProductAInfo
3InfoInfoInfoOrd4IntOrd4Info1InfoProductDInfo
4InfoInfoInfoOrd5IntOrd5Info1InfoProductEInfo
5InfoInfoInfoOrd6IntOrd6Info1InfoProductMInfo
6InfoInfoInfoOrd7IntOrd7Info1InfoProductDInfo
Sheet1


and the expected output in the 'Tracker' file Sheet 2:
Tracker.xlsx
ABCDEFGHIJ
1ColAColBColCCustOrdNoOrderNoColFLnNoColHProductColJ
2InfoInfoInfoOrd2IntOrd2Info1InfoProductBInfo
3InfoInfoInfoOrd3IntOrd3Info1InfoProductCInfo
Sheet2


Thanks in advance for any input that could be provided. Also thanks to advise if I've missed out on anything.
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Try
Rich (BB code): 
Sub test()
    Dim fn$, s$, x, cn As Object, rs As Object
    fn = ThisWorkbook.Path & "\openorders.xlsx"  '<-- change to actual folder path
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    cn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & _
            ThisWorkbook.FullName & ";Extended Properties='Excel 12.0';"
    s = "`Excel 12.0;DataBase=" & fn & "`.`Sheet1$`"  '<-- change Sheet1 to actual sheet name in openorders.xlsx, if needed
    rs.Open "Select * From " & s & " As A Where Not Exists (Select * From " & _
        "`Sheet1$` As B Where A.`CustOrdNo` = " & _
        "B.`CustOrdNo` And A.`OrderNo` = B.`OrderNo`);", cn, , , -1
    Sheets("sheet1").Range("a" & Rows.Count).End(xlUp)(2).CopyFromRecordset rs
    rs.Close
    rs.Open "Select * From `Sheet1$` As A Where Not Exists (Select * From " & _
        s & " As B Where A.`CustOrdNo` = " & _
        "B.`CustOrdNo` And A.`OrderNo` = B.`OrderNo`);", cn, , , -1
    If rs.RecordCount Then
        x = Application.Transpose(Application.Transpose(rs.GetRows(, , 3)))
        rs.MoveFirst
        Sheets("sheet2").Range("a" & Rows.Count).End(xlUp)(2).CopyFromRecordset rs
        With Sheets("sheet1").[a1].CurrentRegion
            .AutoFilter 4, x, 7
            .Offset(1).EntireRow.Delete
            .AutoFilter
        End With
    End If
    Set cn = Nothing: Set rs = Nothing
End Sub
 
Upvote 0
Hi Fuji,

First of all thanks a lot for helping out with this vba code. Really appreciate it.

Couple of clarifications though. Im not the best with VBA so below is as per my thinking.

1. The file 'OpenOrders' is not a path located somewhere on a laptop/server. Its a file that I get via email. So this is basically 2 excel files open side by side.

2. In my limited understanding of your code, I see you reference columns CustOrdNo And OrderNo but essentially I only need to compare rows to rows on each sheet not specially the CustOrdNo And OrderNo columns in both sheets.

Thanks again for your assistance and appreciate your help.
 
Upvote 0
OK,
2 workbooks are open.

Let's see if this works..
Code: 
Sub test()
    Dim wb As Workbook, a, b, i&, ii&, s(1), ub&
    For Each wb In Workbooks
        If wb.Name = ThisWorkbook.Name Then
            a = wb.Sheets(1).[a1].CurrentRegion.Value
        ElseIf UCase$(wb.Name) = "OPENORDERS.XLSX" Then
            b = wb.Sheets(1).[a1].CurrentRegion.Value
        End If
    Next
    If Not IsArray(b) Then MsgBox "OpenOrders.xlsx is not open": Exit Sub
    ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 1), b(1 To UBound(b, 1), 1 To UBound(b, 2) + 1)
    For i = 2 To Application.Max(UBound(a, 1), UBound(b, 1))
        If i <= UBound(a, 1) Then a(i, UBound(a, 2)) = Join(Application.Index(a, i, 0), Chr(2))
        If i <= UBound(b, 1) Then b(i, UBound(b, 2)) = Join(Application.Index(b, i, 0), Chr(2))
    Next
    For i = 2 To UBound(a, 1)
        If a(i, UBound(a, 2)) <> "" Then
            For ii = 2 To UBound(b, 1)
                If b(ii, UBound(b, 2)) <> "" Then
                    If a(i, UBound(a, 2)) = b(ii, UBound(b, 2)) Then
                        a(i, UBound(a, 2)) = "": b(i, UBound(a, 2)) = ""
                    End If
                End If
            Next
        End If
    Next
    With ThisWorkbook.Sheets(1)
        With .[a1].Resize(UBound(a, 1), UBound(a, 2))
            .Value = a: ub = UBound(a, 2)
            .AutoFilter UBound(a, 2), "<>"
            If .Columns(1).SpecialCells(12).Count > 1 Then
                .Offset(1).SpecialCells(12).Copy Sheets("sheet2").Range("a" & Rows.Count).End(xlUp)(2)
                .Offset(1).EntireRow.Delete
            End If
            .AutoFilter
        End With
        .Range("a" & Rows.Count).End(xlUp)(2).Resize(UBound(b, 1), UBound(b, 2)).Value = b
        a = Application.Transpose(Evaluate("row(1:" & UBound(a, 2) - 1 & ")"))
        ReDim Preserve a(0 To UBound(a) - 1)
        .[a1].CurrentRegion.RemoveDuplicates (a), xlNo
        .Columns(ub).Clear
    End With
    Sheets("sheet2").Columns(UBound(b, 2)).Clear
End Sub
 
Upvote 1
Solution
Thanks Fuji,

I tested by removing some rows on the OPENORDERS file and added a new unique row and ran the code but getting error.

Run time error #9
Subscript out of range

and debugger points to Ln21, Col48 till Col73 (highlighted in yellow)
 
Upvote 0
This line?
Rich (BB code): 
                        a(i, UBound(a, 2)) = "": b(i, UBound(a, 2)) = ""
typo, should read as
Rich (BB code): 
                        a(i, UBound(a, 2)) = "": b(i, UBound(b, 2)) = ""

But that means you have different number of columns...
 
Upvote 0
Thanks Fuji,

For some rows, some data columns were missing but they are an exact match between the two files. I then ensured that all data columns are populated and I tried with both as below and each time the same error pops up and points to same location.

: b(i, UBound(a, 2)) = ""

and

: b(i, UBound(b, 2)) = ""
 
Upvote 0
Are you sure that the code now looks like this?
Rich (BB code): 
Sub test()
    Dim wb As Workbook, a, b, i&, ii&, s(1), ub&
    For Each wb In Workbooks
        If wb.Name = ThisWorkbook.Name Then
            a = wb.Sheets(1).[a1].CurrentRegion.Value
        ElseIf UCase$(wb.Name) = "OPENORDERS.XLSX" Then
            b = wb.Sheets(1).[a1].CurrentRegion.Value
        End If
    Next
    If Not IsArray(b) Then MsgBox "OpenOrders.xlsx is not open": Exit Sub
    ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 1), b(1 To UBound(b, 1), 1 To UBound(b, 2) + 1)
    For i = 2 To Application.Max(UBound(a, 1), UBound(b, 1))
        If i <= UBound(a, 1) Then a(i, UBound(a, 2)) = Join(Application.Index(a, i, 0), Chr(2))
        If i <= UBound(b, 1) Then b(i, UBound(b, 2)) = Join(Application.Index(b, i, 0), Chr(2))
    Next
    For i = 2 To UBound(a, 1)
        If a(i, UBound(a, 2)) <> "" Then
            For ii = 2 To UBound(b, 1)
                If b(ii, UBound(b, 2)) <> "" Then
                    If a(i, UBound(a, 2)) = b(ii, UBound(b, 2)) Then
                        a(i, UBound(a, 2)) = "": b(i, UBound(b, 2)) = ""
                    End If
                End If
            Next
        End If
    Next
    With ThisWorkbook.Sheets(1)
        With .[a1].Resize(UBound(a, 1), UBound(a, 2))
            .Value = a: ub = UBound(a, 2)
            .AutoFilter UBound(a, 2), "<>"
            If .Columns(1).SpecialCells(12).Count > 1 Then
                .Offset(1).SpecialCells(12).Copy Sheets("sheet2").Range("a" & Rows.Count).End(xlUp)(2)
                .Offset(1).EntireRow.Delete
            End If
            .AutoFilter
        End With
        .Range("a" & Rows.Count).End(xlUp)(2).Resize(UBound(b, 1), UBound(b, 2)).Value = b
        a = Application.Transpose(Evaluate("row(1:" & UBound(a, 2) - 1 & ")"))
        ReDim Preserve a(0 To UBound(a) - 1)
        .[a1].CurrentRegion.RemoveDuplicates (a), xlNo
        .Columns(ub).Clear
    End With
    Sheets("sheet2").Columns(UBound(b, 2)).Clear
End Sub
 
Upvote 0
Yes 100%, In fact I copied this new code and retried and yet the same result.
 
Upvote 0
Then I need to see your files as it is working with your data in first post at this end.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
VBA to open file using Cell for the path
Replies
4
Views
1K
Peter Davison
P
D
  • Question Question
macro to compare two excel file.
Replies
4
Views
6K
DanteAmor
DanteAmor
D
  • Solved
Error 1004
2
Replies
18
Views
352
dmt32
D
L
  • Solved
Fixing VBA code
Replies
3
Views
683
Joe4
Joe4
S
  • Question Question
Excel VBA - Sort & Get Totals - Logic
Replies
4
Views
365
STARL0RD
S

Forum statistics

Threads
1,223,886
Messages
6,175,198
Members
452,617
Latest member
Narendra Babu D

Share this page

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