VBA Help - Dictionary to seperate date

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
853
Office Version
  1. 2010
Platform
  1. Windows
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
ABCDEFGHIJKLMN
1Today's Input FileTrade Processed previouslyExpected output
2Notional amountNameTransactiono DateInvoice NumberNotional amountNameTransactiono DateInvoice NumberNotional amountNameTransactiono DateInvoice Number
38326.00TAMMY08/14/202031013862-10-PIF8326.00TAMMY08/14/202031013862-10-PIF70.00Robin08/25/20203100009475-10-PMT
49731.00Gary08/14/20203100010134-10-PIF9731.00Gary08/14/20203100010134-10-PIF5663.00Shakiba08/26/20203100010613-35-DEP
51298.00Robert08/14/20203100009765-10-PIF1298.00Robert08/14/20203100009765-10-PIF8000.00Devin08/27/20203100010610-10-DEP
61472.00Angela08/14/2020RW/Lampkin/dep1472.00Angela08/14/2020RW/Lampkin/dep9868.00Mabel08/27/20203100010368-20-PIF
75000.00SUSAN08/14/20203100010384-30-DEP5000.00SUSAN08/14/20203100010384-30-DEP4788.00David08/28/20203100009847-30-PIF
89313.00Mohsin08/14/20203100010384-10-DEP9313.00Mohsin08/14/20203100010384-10-DEP1626.00Aaron08/30/20203100009638-10-PIF
93896.00Charles08/14/2020ST/WIN - Hopkins - Dep3896.00Charles08/14/2020ST/WIN - Hopkins - Dep7000.00Annette08/30/2020RW/Flynn/DEP
101275.00William08/15/202031012973-10-SVC1275.00William08/15/202031012973-10-SVC12701.00Otoniel09/01/202031010292 10 svc
111020.00Bethany08/15/20203100010360-20-DEP1020.00Bethany08/15/20203100010360-20-DEP5000.00donald09/01/202031013211-10-SVC
122900.00TERRI08/17/20203100008686-10-SVC2900.00TERRI08/17/20203100008686-10-SVC1480.00donald09/01/202031027171-10-SVC
138300.00Ryan08/17/202031020362-10-SVC8300.00Ryan08/17/202031020362-10-SVC15000.00John09/01/202031020468-10-SVC
141086.00Donald08/17/202031025089-10-SVC1086.00Donald08/17/202031025089-10-SVC9731.00Robin09/01/20203100001904-10-SVC
153051.00Brian08/17/20203100010587-35-DEP3051.00Brian08/17/20203100010587-35-DEP1298.00Natasha09/02/202031027463-10-SVC
1670.00Robin08/25/20203100009475-10-PMT1472.00Joe09/03/202031027869-10-SVC
175663.00Shakiba08/26/20203100010613-35-DEP5000.00Peter09/04/202031027869-10-SVC
188000.00Devin08/27/20203100010610-10-DEP
199868.00Mabel08/27/20203100010368-20-PIF
204788.00David08/28/20203100009847-30-PIF
211626.00Aaron08/30/20203100009638-10-PIF
227000.00Annette08/30/2020RW/Flynn/DEP
2312701.00Otoniel09/01/202031010292 10 svc
245000.00donald09/01/202031013211-10-SVC
251480.00donald09/01/202031027171-10-SVC
2615000.00John09/01/202031020468-10-SVC
279731.00Robin09/01/20203100001904-10-SVC
281298.00Natasha09/02/202031027463-10-SVC
291472.00Joe09/03/202031027869-10-SVC
305000.00Peter09/04/202031027869-10-SVC
Sheet1


Thanks
mg
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
This works for me with your data

VBA Code:
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

Well-known Member
Joined
Feb 4, 2009
Messages
853
Office Version
  1. 2010
Platform
  1. Windows
Hi Yongle,

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



Thanks
mg
 

Watch MrExcel Video

Forum statistics

Threads
1,126,906
Messages
5,621,581
Members
415,846
Latest member
nigeywigey

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
Top