Automatically select ranges and apply Concatenate Unique

P

Peter Mooney

New Member
Joined
Jul 29, 2017
Messages
6
I have a table of 100,000 plus rows containing finance related data in which I would like to concatenate all the AccountTypes associated with a specific Journal Entry Identifier (JEIdentifier). Column 1 gives the JEIdentifier, Column 2 the AccountTypes, Column3 shows the AccountTypes prefixed with "c" for Credit and "d" for debit. I have found a function on this forum which allows you to specify manually a specific range of data to evaluate a set of records but what I would really like is code that will loop through the JEIdentifier Column and for each JEIndentifier return the associated AccountTypes. I imagine the records could be sorted by JEIdentifier so the code can work through sequential blocks of rows instead of having to read the entire ordered data set of 100,000 rows.

JEIdentifierAccountTypeAccountType2
1000101994Liabilities c|Liabilities c|Liabilities, d|Liabilities, c|Assets, d|Assets
1000101994Liabilities d|Liabilities
1000102019Assets c|Assets
1000102019Assets d|Assets
1000102154Liabilities c|Liabilities
1000102154Liabilities d|Liabilities
1000102155Liabilities c|Liabilities
1000102155Liabilities d|Liabilities
1000102156Liabilities c|Liabilities
1000102156Liabilities d|Liabilities
1000102157Liabilities d|Liabilities
1000102157Liabilities c|Liabilities
1000102158Liabilities c|Liabilities
1000102158Liabilities d|Liabilities
1000102159Liabilities c|Liabilities
1000102159Liabilities d|Liabilities
1000102160Liabilities c|Liabilities
1000102160Liabilities d|Liabilities
1000102160Liabilities d|Liabilities
1000102163Liabilities c|Liabilities
1000102163Liabilities d|Liabilities
1000102163Liabilities d|Liabilities
1000102225Assets c|Assets
1000102225Assets d|Assets

<colgroup><col width="92" style="width:69pt"> <col width="111" style="width:83pt"> <col width="140" style="width:105pt"> <col width="316" style="width:237pt"> </colgroup><tbody>
</tbody>


Function ConcatUniq(xRG As Range, XChar As String) As String
'updateby Extendoffice 20151228
Dim xCell As Range
Dim xDic As Object
Set xDic = CreateObject("Scripting.Dictionary")
For Each xCell In xRG
xDic(xCell.Value) = Empty
Next
ConcatUniq = Join$(xDic.Keys, XChar)
Set xDic = Nothing
End Function
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
Try this:
I put the result in col E:F.

Code: 
[COLOR=blue]Sub[/COLOR] a1016647a[B]()[/B]
[COLOR=blue]Dim[/COLOR] d [COLOR=blue]As[/COLOR] [COLOR=blue]Object[/COLOR][B],[/B] va[B],[/B] i [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
   
    va [B]=[/B] Range[B]([/B][COLOR=brown]"A2"[/COLOR][B],[/B] Cells[B]([/B]Rows.count[B],[/B] [COLOR=brown]"C"[/COLOR][B]).[/B][COLOR=blue]End[/COLOR][B]([/B]xlUp[B])).[/B]Value
    [COLOR=blue]Set[/COLOR] d [B]=[/B] CreateObject[B]([/B][COLOR=brown]"scripting.dictionary"[/COLOR][B])[/B]
   
    [COLOR=blue]For[/COLOR] i [B]=[/B] LBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B] [COLOR=blue]To[/COLOR] UBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B]
          [COLOR=blue]If[/COLOR] d.exists[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [COLOR=blue]Then[/COLOR]
                d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [B]=[/B] d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [B]&[/B] [COLOR=brown]", "[/COLOR] [B]&[/B] va[B]([/B]i[B],[/B] [B][COLOR=crimson]3[/COLOR][/B][B])[/B]
                    [COLOR=blue]Else[/COLOR]
                d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [B]=[/B] [B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]3[/COLOR][/B][B]))[/B]
          [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Next[/COLOR]
   
    Range[B]([/B][COLOR=brown]"E2"[/COLOR][B]).[/B]Resize[B]([/B]d.count[B],[/B] [B][COLOR=crimson]2[/COLOR][/B][B]).[/B]Value [B]=[/B] Application.Transpose[B]([/B]Array[B]([/B]d.Keys[B],[/B] d.Items[B]))[/B]
 
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]
 
Upvote 0
Thank you Aruini.

Running your code certainly concatenates the values in column 3 associated with each record in column 1. I wonder is it also possible to only return Unique values - the example below shows the repeated results quickly accumulate.

JEIdentifierAccountTypeAccountType2Duplicates Returned from Code
3000050168Liabilitiesc|Liabilities3000050168c|Liabilities,d|Assets,c|Expenses,c|Expenses,c|Expenses,c|Expenses,c|Expenses,c|Expenses,c|Expenses,c|Expenses
3000050168Assetsd|Assets
3000050168Expensesc|Expenses
3000050168Expensesc|Expenses
3000050168Expensesc|Expenses
JEIdentifierAccountTypeAccountType2Unique entries from original macro
3000050168Liabilitiesc|Liabilities3000050168c|Liabilities,d|Assets,c|Expenses
3000050168Assetsd|Assets
3000050168Expensesc|Expenses
3000050168Expensesc|Expenses
3000050168Expensesc|Expenses

<tbody>
</tbody>
 
Upvote 0
Ok, try this one:
Code: 
[COLOR=blue]Sub[/COLOR] a1016647b[B]()[/B]
[COLOR=blue]Dim[/COLOR] d [COLOR=blue]As[/COLOR] [COLOR=blue]Object[/COLOR][B],[/B] va[B],[/B] i [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
  
    va [B]=[/B] Range[B]([/B][COLOR=brown]"A2"[/COLOR][B],[/B] Cells[B]([/B]Rows.count[B],[/B] [COLOR=brown]"C"[/COLOR][B]).[/B][COLOR=blue]End[/COLOR][B]([/B]xlUp[B])).[/B]Value
    [COLOR=blue]Set[/COLOR] d [B]=[/B] CreateObject[B]([/B][COLOR=brown]"scripting.dictionary"[/COLOR][B])[/B]
  
    [COLOR=blue]For[/COLOR] i [B]=[/B] LBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B] [COLOR=blue]To[/COLOR] UBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B]
          [COLOR=blue]If[/COLOR] d.exists[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [COLOR=blue]Then[/COLOR]
                [COLOR=blue]If[/COLOR] InStr[B]([/B][B][COLOR=crimson]1[/COLOR][/B][B],[/B] d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])),[/B] va[B]([/B]i[B],[/B] [B][COLOR=crimson]3[/COLOR][/B][B]))[/B] [B]=[/B] [B][COLOR=crimson]0[/COLOR][/B] [COLOR=blue]Then[/COLOR]
                d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [B]=[/B] d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [B]&[/B] [COLOR=brown]", "[/COLOR] [B]&[/B] va[B]([/B]i[B],[/B] [B][COLOR=crimson]3[/COLOR][/B][B])[/B]
                [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
             [COLOR=blue]Else[/COLOR]
                d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [B]=[/B] [B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]3[/COLOR][/B][B]))[/B]
          [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Next[/COLOR]
  
    Range[B]([/B][COLOR=brown]"E2"[/COLOR][B]).[/B]Resize[B]([/B]d.count[B],[/B] [B][COLOR=crimson]2[/COLOR][/B][B]).[/B]Value [B]=[/B] Application.Transpose[B]([/B]Array[B]([/B]d.Keys[B],[/B] d.Items[B]))[/B]
 
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]
 
Upvote 0
Hi Akuini, thank you very much - code a1016647b returns the unique Account Types associated with each JEIdentifier. I can join these records with the original file or use a vlookup so that for every row of original data the AccountType Concatenation is shown. May I ask you if it is possible to include this requirement programmatically so the values are displayed as shown in the two right most columns below. In other words the AccountType concatenations are listed for each row in the original file rather than returned as a normalised list.

JEIdentifierAccountTypeAccountType2JEIdentifier'
1000101994Liabilitiesc|Liabilities1000101994c|Liabilities,d|Liabilities1000101994c|Liabilities, d|Liabilities
1000101994Liabilitiesd|Liabilities1000102019c|Assets,d|Assets1000101994c|Liabilities, d|Liabilities
1000102019Assetsc|Assets1000102154c|Liabilities,d|Liabilities1000102019c|Assets, d|Assets
1000102019Assetsd|Assets1000102155c|Liabilities,d|Liabilities1000102019c|Assets, d|Assets
1000102154Liabilitiesc|Liabilities1000102156c|Liabilities,d|Liabilities1000102154c|Liabilities, d|Liabilities
1000102154Liabilitiesd|Liabilities1000102157d|Liabilities,c|Liabilities1000102154c|Liabilities, d|Liabilities
1000102155Liabilitiesc|Liabilities1000102158c|Liabilities,d|Liabilities1000102155etc

<tbody>
</tbody>
 
Upvote 0
So you want the result to be only as the last 2 column (in your example above)?
Ok, I put the 2 column result in E:F.
But I don’t understand why do you need JEIdentifier (now in col E) as a result? It will be the same with column A.

Code: 
[COLOR=blue]Sub[/COLOR] a1016647c[B]()[/B]
[COLOR=blue]Dim[/COLOR] d [COLOR=blue]As[/COLOR] [COLOR=blue]Object[/COLOR][B],[/B] va[B],[/B] vc[B],[/B] i [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
  
    va [B]=[/B] Range[B]([/B][COLOR=brown]"A2"[/COLOR][B],[/B] Cells[B]([/B]Rows.count[B],[/B] [COLOR=brown]"C"[/COLOR][B]).[/B][COLOR=blue]End[/COLOR][B]([/B]xlUp[B])).[/B]Value
    [COLOR=blue]ReDim[/COLOR] vc[B]([/B][B][COLOR=crimson]1[/COLOR][/B] [COLOR=blue]To[/COLOR] UBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]),[/B] [B][COLOR=crimson]1[/COLOR][/B] [COLOR=blue]To[/COLOR] [B][COLOR=crimson]2[/COLOR][/B][B])[/B]
    [COLOR=blue]Set[/COLOR] d [B]=[/B] CreateObject[B]([/B][COLOR=brown]"scripting.dictionary"[/COLOR][B])[/B]
  
    [COLOR=blue]For[/COLOR] i [B]=[/B] LBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B] [COLOR=blue]To[/COLOR] UBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B]
          [COLOR=blue]If[/COLOR] d.Exists[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [COLOR=blue]Then[/COLOR]
                [COLOR=blue]If[/COLOR] InStr[B]([/B][B][COLOR=crimson]1[/COLOR][/B][B],[/B] d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])),[/B] va[B]([/B]i[B],[/B] [B][COLOR=crimson]3[/COLOR][/B][B]))[/B] [B]=[/B] [B][COLOR=crimson]0[/COLOR][/B] [COLOR=blue]Then[/COLOR]
                d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [B]=[/B] d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [B]&[/B] [COLOR=brown]", "[/COLOR] [B]&[/B] va[B]([/B]i[B],[/B] [B][COLOR=crimson]3[/COLOR][/B][B])[/B]
                [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
             [COLOR=blue]Else[/COLOR]
                d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [B]=[/B] [B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]3[/COLOR][/B][B]))[/B]
          [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Next[/COLOR]
   
    [COLOR=blue]For[/COLOR] i [B]=[/B] LBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B] [COLOR=blue]To[/COLOR] UBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B]
        vc[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B] [B]=[/B] va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B]
        vc[B]([/B]i[B],[/B] [B][COLOR=crimson]2[/COLOR][/B][B])[/B] [B]=[/B] d[B]([/B]va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B]
    [COLOR=blue]Next[/COLOR]
   
    Range[B]([/B][COLOR=brown]"E2"[/COLOR][B]).[/B]Resize[B]([/B]UBound[B]([/B]vc[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]),[/B] [B][COLOR=crimson]2[/COLOR][/B][B]).[/B]Value [B]=[/B] vc
 
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]
 
Last edited:
Upvote 0
Akuini, thank you for the latest code. Yes you are correct now that the results for every row are returned it is not necessary to show the JE Identifier. If this can be removed easily, I would be grateful if you could do that. Thank you
 
Upvote 0
OK.
Code: 
Sub a1016647d()
Dim d As Object, va, vc, i As Long
   
    va = Range("A2", Cells(Rows.count, "C").End(xlUp)).Value
    ReDim vc(1 To UBound(va, 1), 1 To 1)
    Set d = CreateObject("scripting.dictionary")
   
    For i = LBound(va, 1) To UBound(va, 1)
          If d.Exists(va(i, 1)) Then
                If InStr(1, d(va(i, 1)), va(i, 3)) = 0 Then
                d(va(i, 1)) = d(va(i, 1)) & ", " & va(i, 3)
                End If
             Else
                d(va(i, 1)) = (va(i, 3))
          End If
    Next
    
    For i = LBound(va, 1) To UBound(va, 1)
        vc(i, 1) = d(va(i, 1))
    Next
    
    Range("E2").Resize(UBound(vc, 1), 1).Value = vc
 
End Sub
 
Upvote 0
=TEXTJOIN(",",TRUE,IF($A$2:$A$25=A2,$C$2:$C$25,"")) Ctrl+Shift+Enter
This formula will give the result in office 2016.
 
Upvote 0
Hi Akuini, many thanks for your solutions. Version b returns concatenated unique values in column C associated with unique values in column A; and version d returns concatenated unique values in column C associated with each value (row) in column A. Perfect solutions thank you and super fast to execute for 240,000 rows on an intel i7, 16GB Ram laptop.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Concatenate Unique Values - Minor VBA issue
Replies
4
Views
2K
Dan5977
D
Q
  • Question
Formula to Concatenate Unique Values into 1 cell
Replies
3
Views
861
kvsrinivasamurthy
K

Forum statistics

Threads
1,214,649
Messages
6,120,732
Members
448,987
Latest member
marion_davis

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