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

S

sncb

Board Regular
Joined
Mar 17, 2011
Messages
160
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.
 
Sort by date Sort by votes
sncb said:
If wb.Name = Tracking.Name Then

and the file name is Tracking.xlsm
Click to expand...
How/where did you set the reference to object variable Tracking?

You should have the line like
Code: 
Set Tracnking = blah
 
Upvote 0

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
As the filename is Tracking.xlsm, in the code I changed the filename in 2 places. Ln4 and Ln 27

Ln4:
If wb.Name = Tracking.xlsm Then

Ln27:
With Tracking.Sheets(1)

Where else do I need to change/adapt? Sorry not familiar with VB.
 
Upvote 0
Then it should look like
Rich (BB code): 
Sub test()
    Dim wb As Workbook, a, b, i&, ii&, s(1), ub&
    Dim Tracking As Workbook
    On Error Resume Next
    Set Tracking = Workbooks("Tracking.xlsm")
    On Error Goto 0
    If Tracking Is Nothing Then MsgBox "Tracking.xlsm Is Not Open": Exit Sub
    a = ThisWorkbook.Sheets(1).[a1].CurrentRegion.Value
    b = Tracking.Sheets(1).[a1].CurrentRegion.Value
    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 0
Thanks Fuji, This however did not work. As I see this new code, there is no reference to the 'OPENORDERS' file.
 
Upvote 0
See if this works...
Code: 
Sub test()
    Dim wb(1 To 2) As Workbook, a, b, e, i&, ii&, s(1), ub&
    For Each e In Array("Tracking.xlsx", "OpenOrders.xlsx")
        If Not IsOpen(e) Then
            MsgBox e & " is not open": Exit Sub
        Else
            i = i + 1
            Set wb(i) = Workbooks(e)
        End If
    Next
    a = wb(1).Sheets(1).[a1].CurrentRegion.Value
    b = wb(2).Sheets(1).[a1].CurrentRegion.Value
    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 wb(1).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
        wb(1).Sheets("sheet2").Columns(UBound(b, 2)).Clear
    End With
End Sub

Function IsOpen(ByVal wbName As String) As Boolean
    On Error Resume Next
    IsOpen = Len(Workbooks(wbName).Name)
    On Error GoTo 0
End Function
 
Upvote 1
Thanks. this almost works 99%. The only thing that's happening is that when I run the macro, all the records in Tracker Sheet1 are moved to Sheet2 whereas only the processed ones should move to Sheet2. The ones remaining in Sheet1 are ok but all of them are moving to Sheet2.

If its too much of a hassle, let it be, I can live with this. But thanks again for your effort. it helps to ease the work.
 
Upvote 0
Tested and everything is OK here.
I can only guess the reason that it doesn't work at you end is that # of columns are different.

Make sure the variable "cols" has enough number of columns for both files, now 20.
Rich (BB code): 
Sub test()
    Dim wb(1 To 2) As Workbook, a, b, e, i&, ii&, s(1), ub&, cols&
    cols = 20  '<--- change here
    For Each e In Array("Tracking.xlsx", "OpenOrders.xlsx")
        If Not IsOpen(e) Then
            MsgBox e & " is not open": Exit Sub
        Else
            i = i + 1
            Set wb(i) = Workbooks(e)
        End If
    Next
    a = wb(1).Sheets(1).[a1].CurrentRegion.Resize(, cols).Value
    b = wb(2).Sheets(1).[a1].CurrentRegion.Resize(, cols).Value
    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 wb(1).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
        With [a1].CurrentRegion
            .Columns(UBound(b, 2)).Clear
            a = Application.Transpose(Evaluate("row(1:" & .Columns.Count & ")"))
            ReDim Preserve a(0 To UBound(a) - 1)
            .RemoveDuplicates (a)
        End With
        wb(1).Sheets("sheet2").Columns(UBound(b, 2)).Clear
    End With
End Sub

Function IsOpen(ByVal wbName As String) As Boolean
    On Error Resume Next
    IsOpen = Len(Workbooks(wbName).Name)
    On Error GoTo 0
End Function
 
Upvote 0
Hi Fuji, just saw this. Ok will check and post back later today. thanks again.
 
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
macro to compare two excel file.
Replies
4
Views
4K
DanteAmor
DanteAmor
S
  • Question
Excel VBA - Sort & Get Totals - Logic
Replies
4
Views
222
STARL0RD
S
L
  • Solved
Fixing VBA code
Replies
3
Views
648
Joe4
Joe4
N
  • Solved
Copy/paste a row from within a loop, before that loop moves on to next cell
Replies
5
Views
470
Joe4
Joe4

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,399
Latest member
alchavar

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