Matching lines of data using a macro to a set rules?

SHARRIS2013

New Member
Joined
Jan 3, 2013
Messages
10
Hi,
I have a set of data like the below in sheet 1, i need to match the data by order number and show differences as exeptions on sheet 2

Order</SPAN>Purchase/Sale</SPAN>Currency</SPAN>CCY 1</SPAN>AMT 1</SPAN>CCY 2</SPAN>AMT 2</SPAN>Date
123</SPAN>P</SPAN>GBP/USD</SPAN>GBP</SPAN>100</SPAN>USD</SPAN>160</SPAN>29/01/2013
567</SPAN>S</SPAN>EUR/GBP</SPAN>EUR</SPAN>125</SPAN>GBP</SPAN>100</SPAN>29/01/2013
123</SPAN>S</SPAN>GBP/USD</SPAN>GBP</SPAN>100</SPAN>USD</SPAN>170</SPAN>29/01/2013
999</SPAN>S</SPAN>EUR/GBP</SPAN>EUR</SPAN>125</SPAN>GBP</SPAN>100</SPAN>28/01/2013
999</SPAN>P</SPAN>EUR/GBP</SPAN>EUR</SPAN>115</SPAN>GBP</SPAN>100</SPAN>29/01/2013

<TBODY>
</TBODY><COLGROUP><COL><COL><COL span=5></COLGROUP>


Rules:
Based on 2 matching order numbers
currency = same
date = same
purchase and sale = should be one of each amongst the two order number entries
either amt 1 or amt 2 must be the same (it wont necesirily always be amt 1)

outputs for sheet 2:
single order numbers
matching order numbers not meeting the above rules

(so with the above i would see order 567 as a single and 999 as a mismatch, due to date difference)

Is it possible to achieve the above in excel? Or would i need to use access? If someone could assist with the code that would be great!

Thanks!
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Try this for results on sheet(2)
Code:
[COLOR="Navy"]Sub[/COLOR] MG29Jan19
[COLOR="Navy"]Dim[/COLOR] Rng         [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] Q
[COLOR="Navy"]Dim[/COLOR] Ps          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Array(Dn, Dn(, 2), Dn(, 5), Dn(, 7), CDbl(DateValue(Dn(, 8))))
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Dn.Value)
        Ps = IIf(Q(1) = "P", "S", "P")
          [COLOR="Navy"]If[/COLOR] Dn(, 2) = Ps And Q(4) = CDbl(DateValue(Dn(, 8))) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]If[/COLOR] Q(2) = Dn(, 5) Or Q(3) = Dn(, 7) [COLOR="Navy"]Then[/COLOR]
                    .Remove (Dn.Value)
                [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
               .Item(Dn.Value) = Q
        [COLOR="Navy"]End[/COLOR] If
        
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rw      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] A       [COLOR="Navy"]As[/COLOR] Range
ReDim ray(1 To Rng.Count, 1 To 8)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] A [COLOR="Navy"]In[/COLOR] .Item(k)(0).Areas
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rw [COLOR="Navy"]In[/COLOR] A
            c = c + 1
            [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(ray, 2)
                [COLOR="Navy"]If[/COLOR] Ac = 8 [COLOR="Navy"]Then[/COLOR]
                    ray(c, Ac) = Format(Rw(, Ac), "dd/mm/yyyy")
                [COLOR="Navy"]Else[/COLOR]
                    ray(c, Ac) = Rw(, Ac)
               [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] Ac
        [COLOR="Navy"]Next[/COLOR] Rw
    [COLOR="Navy"]Next[/COLOR] A
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    .Range("A1:H1").Value = Range("A1:H1").Value
    .Range("A2").Resize(c, UBound(ray, 2)) = ray
[COLOR="Navy"]End[/COLOR] With
MsgBox "run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,

Thanks for the response! I have to admit i am not very vba literate so i'm not really understanding the code, when i run the macro if falls over at
.Add Dn.Value, Array(Dn, Dn(, 2), Dn(, 5), Dn(, 7), CDbl(DateValue(Dn(, 8))))
I have my data starting in cell A2 in sheet 1 which is what i think you have too so i am unsure what i have done wrong as i just copied and pasted into the visual basic editor?
Could you assist again pls?

Thanks
 
Upvote 0
This will not work if you are running it on a "Mac".
I have just copied it back from the thread and run it successfully from sht (1).
The code reads the data from Row (2), Row (1) is the header row.
If you have your Headers in row (2) then alter the lines below
Rich (BB code):
Set Rng = Range(Range("A3"), Range("A" & Rows.Count).End(xlUp))
and
Rich (BB code):
With Sheets("Sheet2")
    .Range("A1:H1").Value = Range("A2:H2").Value
    .Range("A2").Resize(c, UBound(ray, 2)) = ray
End With
]

[/code]
 
Upvote 0
Hi again Mick, very sorry to be a pain, my extract i am using has changed, i tried to amend the code to take into account the changes but ended up by copying across all records rather than just the exceptions, would you be able to amend the code to reflect the new columns at all pls? Thank you!</SPAN>
Below starts in cell A7, to column Q, all rules still remain the same but the columns have changed</SPAN>
Rules:</SPAN>
Based on 2 matching order numbers</SPAN>
currency = same</SPAN>
date = same</SPAN>
buy and sale = should be one of each amongst the two order number entries</SPAN>
either amt 1 or amt 2 must be the same (it wont necessarily always be amt 1)</SPAN>
LOG</SPAN>ORDER</SPAN>ACCOUNT</SPAN>CODE</SPAN>PRODUCT</SPAN>CURRENCY</SPAN>RATE</SPAN>Buy/Sale</SPAN>CCY 1</SPAN>AMT 1</SPAN>CCY 2</SPAN>AMT 2</SPAN>INPUT DATE</SPAN>PAY Date</SPAN>BY</SPAN>STATUS</SPAN>VALIDATED</SPAN>
21</SPAN>123</SPAN>TUB</SPAN>PQ</SPAN>FXD</SPAN>GBP/USD</SPAN>1.60</SPAN>B</SPAN>GBP</SPAN>100</SPAN>USD</SPAN>160</SPAN>01/01/2013</SPAN>29/01/2013</SPAN>UK_GW</SPAN>LIVE</SPAN>1s</SPAN>
2</SPAN>567</SPAN>FLB</SPAN>PQ</SPAN>FXD</SPAN>EUR/GBP</SPAN>0.80</SPAN>S</SPAN>EUR</SPAN>125</SPAN>GBP</SPAN>100</SPAN>01/01/2013</SPAN>29/01/2013</SPAN>UK_GW</SPAN>LIVE</SPAN>1s</SPAN>
78</SPAN>123</SPAN>KOB</SPAN>PQ</SPAN>FXD</SPAN>GBP/USD</SPAN>1.70</SPAN>S</SPAN>GBP</SPAN>100</SPAN>USD</SPAN>170</SPAN>01/01/2013</SPAN>29/01/2013</SPAN>UK_NTA</SPAN>LIVE</SPAN>1s</SPAN>
33</SPAN>999</SPAN>KOB</SPAN>PQ</SPAN>FXD</SPAN>EUR/GBP</SPAN>0.80</SPAN>S</SPAN>EUR</SPAN>125</SPAN>GBP</SPAN>100</SPAN>01/01/2013</SPAN>28/01/2013</SPAN>UK_NTA</SPAN>LIVE</SPAN>1s</SPAN>
5</SPAN>999</SPAN>KOB</SPAN>PQ</SPAN>FXD</SPAN>EUR/GBP</SPAN>0.87</SPAN>B</SPAN>EUR</SPAN>115</SPAN>GBP</SPAN>100</SPAN>01/01/2013</SPAN>29/01/2013</SPAN>UK_NTA</SPAN>LIVE</SPAN>1s</SPAN>
11</SPAN>555</SPAN>TUB</SPAN>PQ</SPAN>FXD</SPAN>EUR/GBP</SPAN>0.80</SPAN>B</SPAN>EUR</SPAN>125</SPAN>GBP</SPAN>100</SPAN>01/01/2013</SPAN>28/01/2013</SPAN>UK_NTA</SPAN>LIVE</SPAN>1s</SPAN>
43</SPAN>555</SPAN>TUB</SPAN>PQ</SPAN>FXD</SPAN>EUR/GBP</SPAN>0.87</SPAN>S</SPAN>EUR</SPAN>115</SPAN>GBP</SPAN>100</SPAN>01/01/2013</SPAN>28/01/2013</SPAN>UK_NTA</SPAN>LIVE</SPAN>1s</SPAN>
65</SPAN>666</SPAN>TUB</SPAN>PQ</SPAN>FXD</SPAN>EUR/GBP</SPAN>0.80</SPAN>S</SPAN>EUR</SPAN>125</SPAN>GBP</SPAN>100</SPAN>01/01/2013</SPAN>28/01/2013</SPAN>UK_NTA</SPAN>LIVE</SPAN>1s</SPAN>
34</SPAN>666</SPAN>TUB</SPAN>PQ</SPAN>FXD</SPAN>EUR/GBP</SPAN>0.87</SPAN>S</SPAN>EUR</SPAN>115</SPAN>GBP</SPAN>100</SPAN>01/01/2013</SPAN>28/01/2013</SPAN>UK_NTA</SPAN>LIVE</SPAN>1s</SPAN>

<TBODY>
</TBODY><COLGROUP><COL span=13><COL><COL span=3></COLGROUP>

outputs for sheet 2: the entire row of data from sheet 1 showing:</SPAN>

single order numbers</SPAN>
matching order numbers not meeting the above rules</SPAN>

I would be really apprecuiative if you could drop me the code for this and then i can try and establish what has changed between the first one in order to learn

Thanks, Shy

<TBODY>
</TBODY>
 
Upvote 0
Try this:-
Just to confirm the starting point In you data, the word "Log" is in "A7".
The results start "A1" Sheet (2)
Code:
[COLOR="Navy"]Sub[/COLOR] MG30Jan29
[COLOR="Navy"]Dim[/COLOR] Rng         [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] Q
[COLOR="Navy"]Dim[/COLOR] Ps          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B8"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Array(Dn, Dn(, 7), Dn(, 9), Dn(, 11), CDbl(DateValue(Dn(, 12))), CDbl(DateValue(Dn(, 13))))
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Dn.Value)
        Ps = IIf(Q(1) = "B", "S", "B")
          [COLOR="Navy"]If[/COLOR] Dn(, 7) = Ps And Q(4) = CDbl(DateValue(Dn(, 12))) And Q(5) = CDbl(DateValue(Dn(, 13))) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]If[/COLOR] Q(2) = Dn(, 9) Or Q(3) = Dn(, 11) [COLOR="Navy"]Then[/COLOR]
                    .Remove (Dn.Value)
                [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
               .Item(Dn.Value) = Q
        [COLOR="Navy"]End[/COLOR] If
        
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rw      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] A       [COLOR="Navy"]As[/COLOR] Range
ReDim ray(1 To Rng.Count, 1 To 17)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] A [COLOR="Navy"]In[/COLOR] .Item(k)(0).Areas
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rw [COLOR="Navy"]In[/COLOR] A
            c = c + 1
            [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(ray, 2)
                [COLOR="Navy"]If[/COLOR] Ac = 12 Or Ac = 13 [COLOR="Navy"]Then[/COLOR]
                    ray(c, Ac) = Format(Rw(, Ac), "dd/mm/yyyy")
                [COLOR="Navy"]Else[/COLOR]
                    ray(c, Ac) = Rw(, Ac - 1)
               [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] Ac
        [COLOR="Navy"]Next[/COLOR] Rw
    [COLOR="Navy"]Next[/COLOR] A
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    .Range("A1:q1").Value = Range("A7:q7").Value
    .Range("A2").Resize(c, UBound(ray, 2)) = ray
[COLOR="Navy"]End[/COLOR] With
MsgBox "run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
That's awesome thanks so much Mick, i will try and understand what each part does and see where i was going wrong when i tried to adjust the original code

thanks again for your help
 
Upvote 0

Forum statistics

Threads
1,214,952
Messages
6,122,457
Members
449,083
Latest member
Ava19

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