VBA Help - Dictionary to seperate date

[Mallesh23]

Hi Team,

I have two range of data, from this I have to extract New Trades on which I need to work.
Criteria is Transaction Date Column. Compare Column C and H , extract output in range (K2) using dictionary approach.
or any other method. Thanks

1) Range("A2:D30") is my input file.
2) Range("F2:I15") is my previous output Range.

Expected output Range
3) Range("K2:k17")

Book4
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1		Today's Input File					Trade Processed previously					Expected output
2	Notional amount	Name	Transactiono Date	Invoice Number		Notional amount	Name	Transactiono Date	Invoice Number		Notional amount	Name	Transactiono Date	Invoice Number
3	8326.00	TAMMY	08/14/2020	31013862-10-PIF		8326.00	TAMMY	08/14/2020	31013862-10-PIF		70.00	Robin	08/25/2020	3100009475-10-PMT
4	9731.00	Gary	08/14/2020	3100010134-10-PIF		9731.00	Gary	08/14/2020	3100010134-10-PIF		5663.00	Shakiba	08/26/2020	3100010613-35-DEP
5	1298.00	Robert	08/14/2020	3100009765-10-PIF		1298.00	Robert	08/14/2020	3100009765-10-PIF		8000.00	Devin	08/27/2020	3100010610-10-DEP
6	1472.00	Angela	08/14/2020	RW/Lampkin/dep		1472.00	Angela	08/14/2020	RW/Lampkin/dep		9868.00	Mabel	08/27/2020	3100010368-20-PIF
7	5000.00	SUSAN	08/14/2020	3100010384-30-DEP		5000.00	SUSAN	08/14/2020	3100010384-30-DEP		4788.00	David	08/28/2020	3100009847-30-PIF
8	9313.00	Mohsin	08/14/2020	3100010384-10-DEP		9313.00	Mohsin	08/14/2020	3100010384-10-DEP		1626.00	Aaron	08/30/2020	3100009638-10-PIF
9	3896.00	Charles	08/14/2020	ST/WIN - Hopkins - Dep		3896.00	Charles	08/14/2020	ST/WIN - Hopkins - Dep		7000.00	Annette	08/30/2020	RW/Flynn/DEP
10	1275.00	William	08/15/2020	31012973-10-SVC		1275.00	William	08/15/2020	31012973-10-SVC		12701.00	Otoniel	09/01/2020	31010292 10 svc
11	1020.00	Bethany	08/15/2020	3100010360-20-DEP		1020.00	Bethany	08/15/2020	3100010360-20-DEP		5000.00	donald	09/01/2020	31013211-10-SVC
12	2900.00	TERRI	08/17/2020	3100008686-10-SVC		2900.00	TERRI	08/17/2020	3100008686-10-SVC		1480.00	donald	09/01/2020	31027171-10-SVC
13	8300.00	Ryan	08/17/2020	31020362-10-SVC		8300.00	Ryan	08/17/2020	31020362-10-SVC		15000.00	John	09/01/2020	31020468-10-SVC
14	1086.00	Donald	08/17/2020	31025089-10-SVC		1086.00	Donald	08/17/2020	31025089-10-SVC		9731.00	Robin	09/01/2020	3100001904-10-SVC
15	3051.00	Brian	08/17/2020	3100010587-35-DEP		3051.00	Brian	08/17/2020	3100010587-35-DEP		1298.00	Natasha	09/02/2020	31027463-10-SVC
16	70.00	Robin	08/25/2020	3100009475-10-PMT							1472.00	Joe	09/03/2020	31027869-10-SVC
17	5663.00	Shakiba	08/26/2020	3100010613-35-DEP							5000.00	Peter	09/04/2020	31027869-10-SVC
18	8000.00	Devin	08/27/2020	3100010610-10-DEP
19	9868.00	Mabel	08/27/2020	3100010368-20-PIF
20	4788.00	David	08/28/2020	3100009847-30-PIF
21	1626.00	Aaron	08/30/2020	3100009638-10-PIF
22	7000.00	Annette	08/30/2020	RW/Flynn/DEP
23	12701.00	Otoniel	09/01/2020	31010292 10 svc
24	5000.00	donald	09/01/2020	31013211-10-SVC
25	1480.00	donald	09/01/2020	31027171-10-SVC
26	15000.00	John	09/01/2020	31020468-10-SVC
27	9731.00	Robin	09/01/2020	3100001904-10-SVC
28	1298.00	Natasha	09/02/2020	31027463-10-SVC
29	1472.00	Joe	09/03/2020	31027869-10-SVC
30	5000.00	Peter	09/04/2020	31027869-10-SVC
Sheet1

Thanks
mg

 

[Yongle]

This works for me with your data

Sub NewTrade()
    Dim OldDict As Object, arrIn As Variant, arrOld As Variant, arrNew() As Variant
    Dim a As Long, b As Long, r As Long, x As String
    Const z = "|"
    Set OldDict = CreateObject("Scripting.Dictionary")
    arrIn = Range("A2:D30").Value
    arrOld = Range("F3:I15").Value
    
'prior values
    For a = 1 To UBound(arrOld)
        x = arrOld(a, 1) & z & arrOld(a, 2) & z & arrOld(a, 3) & z & arrOld(a, 4)
        If Not OldDict.Exists(x) Then OldDict.Add x, x
    Next a
'get new values
    ReDim arrNew(1 To UBound(arrIn), 1 To 4)
    For a = 1 To UBound(arrIn)
        x = arrIn(a, 1) & z & arrIn(a, 2) & z & arrIn(a, 3) & z & arrIn(a, 4)
        If Not OldDict.Exists(x) Then
            r = r + 1
            For b = 0 To 3
                arrNew(r, b + 1) = Split(x, z)(b)
            Next b
        End If
    Next a
'write to sheet
    Range("K2").Resize(UBound(arrIn), 4).Value = arrNew
End Sub

 

[Mallesh23]

Hi Yongle,

Perfect ! Nice piece of Code ! This has worked ! . I will learn it and start using in my coming projects.



Thanks
mg