How to combine duplicate entries in one cell

ThrottleWorks · Sep 16, 2015

Hi @Marc L , you are correct. I need to sort column A,B and C.

Marc L · Sep 16, 2015

So with only the first columns sorted there is a glitch !

According to post #14 attachment and post #15 Luke's code,
mod the source data like this :

Consolidate procedure result :

Demo4 (just Demo3 with Sheet2 as destination worksheet) result :

Try …

ThrottleWorks · Sep 16, 2015

Hi @Marc L , thanks a lot for the help.

You are right, I missed this too...
I guess I need to sort Column D and E also to get the correct results.
Kindly correct me if I am wrong.

Marc L · Sep 16, 2015

Still possible to have an issue, wait for Luke's point of view.

But with my way you don't need to sort any column …

ThrottleWorks · Sep 16, 2015

Hi @Marc L , thanks a lot for the help.
I tried your code a while ago, it's working perfect with the sample book provided by me.

Format of the original data is bit different and to be honest I did not understand your code at first glance (my mistake).

Before applying your code I need to understand the code then only I will be able to edit it, at present I was occupied with editing, testing with Luke Sir's code.

Please do not feel offended. Good night.

Luke M · Sep 16, 2015

good morning guys.

About the lastMatch boolean...you should not include that. I started to think I would need to check if last row was captured, but I was incorrect.

Per latest glitch, Marc is right, I forgot to realize that some numbers can be inside others. Should include the delimter...

Overall, Marc's idea of using a Dictionary is probably the better way to go. I've off to have some celebratory drinks.

Don't worry, if still troubles tomorrow, I'll be back.

ThrottleWorks · Sep 16, 2015

Hi @Luke M Sir, thanks a lot for the help.

"lastMatch boolean...you should not include" yes, I have excluded this.
Enjoy your day Sir !

:D

Marc L · Sep 16, 2015

In my way :

DL is the delimiter constant;
VA array is the source rows data;
STPM string array is the concatenated keys of the columns
Sales Person, Team and Model;
OUTP string array is the output;
K is a key string variable;
R is a source rows counter;
C is a source columns counter;
L is an output rows counter …

Progress in code with F8 key and ckeck the Locals window,
you'll see this is an easy way !

ThrottleWorks · Sep 16, 2015

Hi @Marc L , thanks a lot for the help. I will definitely check it. Good night.

Marc L · Sep 17, 2015

Little glitch when Regional settings are not US : in some
Europa countries, numbers thousands delimiter is space.

Source data :

Consolidate (on a computer with some european Regional settings) :

E4 result : VBA - US native whatever the local Excel version - recognizes
10,100 as a number, not like two items delimited by a comma,
so space replaces comma according to Regional settings !

Using comma + space (better readibility also) like my Demo :

Minor issue to take in consideration within an international project …

Marc L · Sep 17, 2015

Marc L said:
STPM string array is the concatenated keys of the columns
Sales Person, Team and Model;

My bad, it's SPTM !

Marc L · Sep 17, 2015

ThrottleWorks said:
I guess I need to sort Column D and E also to get the correct results.
Kindly correct me if I am wrong.

An issue is still possible, example with this sorted source data :

'Cause 2 in D4 is before 22 in D5,
100 in E4 will always be before 10 in E5,
so same issue with post #15 Consolidate :

As Luke wrote, should include the delimiter to compare …

Marc L · Sep 17, 2015

Without using dictionary neither array variable,
just checking duplicate in columns D & E with Instr function
and with only 3 counter variables, according to first attachment,
paste code to worksheet module :

Code:

Sub EasyDemo1()
Const DL = ", "
Application.ScreenUpdating = False:  L& = 2
 
With Cells(7).CurrentRegion.Rows
    If .Count > 2 Then .Item("3:" & .Count).Clear
End With
 
With Cells(1).CurrentRegion.Rows
    For R& = 3 To .Count
        With .Item(R)
            If .Cells(1).Value = Cells(L, 7).Value And .Cells(2).Value = Cells(L, 8).Value And .Cells(3).Value = Cells(L, 9).Value Then
                For C% = 4 To 5
                    If InStr(DL & Cells(L, C + 6).Value & DL, DL & .Cells(C).Value & DL) = 0 Then Cells(L, C + 6).Value = Cells(L, C + 6).Value & DL & .Cells(C).Value
                Next
            Else
                L = L + 1
                .Cells.Copy Rows(L).Columns("G:K")
            End If
        End With
    Next
End With
 
With Cells(7).CurrentRegion.Columns("D:E"):  .HorizontalAlignment = xlCenter:  .AutoFit:  End With
End Sub

With big data, an easy demonstration often means a slower way …

Marc L · Sep 17, 2015

This second easy demonstration belongs to other attachments
and can work only within output worksheet module
(no mod whatever the other attachment as long source worksheet is Sheet1 !) :

Code:

Sub EasyDemo2()
Const DL = ", "
Application.ScreenUpdating = False:  L& = 2

With Cells(1).CurrentRegion.Rows
    If .Count > 2 Then .Item("3:" & .Count).Clear
End With

With Sheet1.Cells(1).CurrentRegion.Rows
    For R& = 3 To .Count
        With .Item(R)
            If .Cells(1).Value = Cells(L, 1).Value And .Cells(2).Value = Cells(L, 2).Value And .Cells(3).Value = Cells(L, 3).Value Then
                For C% = 4 To 5
                    If InStr(DL & Cells(L, C).Value & DL, DL & .Cells(C).Value & DL) = 0 Then Cells(L, C).Value = Cells(L, C).Value & DL & .Cells(C).Value
                Next
            Else
                                           L = L + 1
                Rows(L).Columns("A:E").Value = .Cells.Value
            End If
        End With
    Next
End With

With Cells(1).CurrentRegion.Columns("D:E"):  .HorizontalAlignment = xlCenter:  .AutoFit:  End With
Application.Goto Cells(1), True
End Sub

There are other ways, faster, but I don't think easier …

Edit : these easy demonstrations are based upon the assumption
of source first 3 columns are sorted before code execution !

Edit #2 : same way as Luke with delimiter to compare …

ThrottleWorks · Sep 18, 2015

Hi @Marc L , sorry for late reply. I am checking this and will revert with details.

Have a nice day ahead.

Marc L · Sep 18, 2015

Hi ! You do not need to apologize 'cause
first, we are not on the same time zone !

And you was studing Luke's way …
So with the demonstrations I posted, I know you need time !

And I have not yet shown you hybrid way ! (Worth with big data)
How many rows in your real workbook : hundreds, thousands ?

ThrottleWorks · Sep 18, 2015

Hi @Marc L , rows, do not even ask, may 20 or max 30 or sometimes 5 !

I have not yet shown you hybrid way

Waiting for the

Sir !

Kindly post if you get time, will help me to learn.

Marc L · Sep 18, 2015

So with so few rows you have enough material !

In VBA with Excel object model,
there are often many ways to reach a result !

If we take a look at Demo3 procedure, source data are duplicate
into memory via an array variable (VA) to speed up operations.
SPTM array is a concatenation of unique elements from the 3 first columns
and OUTP array is the output data where are also these 3 first columns !
STPM and OUTP are sized from source rows number.
Many duplicates but not a concern with small data as yours …

But in a huge data case, lakhs rows and imagine around only one thousand
unique elements, sizing these arrays to same source rows number is near
a non sense, could have a memory issue with older Excel version
(before 2003) or as well in recent version (32 bits) if source data have also
a lot of columns and with only the need of 5 columns in the result !

So one choice is to use an easy demonstration but writing cell by cell
takes a lot of time with huge data.
Or a middle way : no array for source data but use just the necessary array
for output, preserving operations speed.
But even with this kind of hybrid conception, there may be several ways
with filter, advanced filter, Dictionary object, … Sky is the limit !

Next codes do not work with original but with other attachments,
paste them to output worksheet module.
I stay with the InStr VBA function to compare, like in Luke's and Easy ways
'cause there is few elements to combine in D & E columns.
Using Match & Split functions could be faster with much more data …

Let's start with an advanced filter way :

Code:

Sub DemoH1()
Application.ScreenUpdating = False

With Cells(1).CurrentRegion.Rows
    If .Count > 2 Then .Item("3:" & .Count).Clear
End With

With Sheet1.Cells(1).CurrentRegion.Rows
    If .Count < 3 Then Exit Sub
    .Item("2:" & .Count).Columns("A:C").AdvancedFilter xlFilterCopy, , [A2:C2], True

    With Cells(1).CurrentRegion.Rows
        With .Item("3:" & .Count).Columns("A:C").Rows
             .Borders.LineStyle = xlLineStyleNone:  .Font.Size = 11
            ReDim SPTM$(1 To .Count), OUTP$(1 To .Count, 4 To 5)
            For L& = 1 To .Count:  SPTM(L) = .Cells(L, 1) & "¤" & .Cells(L, 2) & "¤" & .Cells(L, 3):  Next
        End With
    End With
                            D = Array("", ", ")
    For R& = 3 To .Count
        L = Application.Match(.Cells(R, 1) & "¤" & .Cells(R, 2) & "¤" & .Cells(R, 3), SPTM, 0)
        For C% = 4 To 5
            If InStr(D(1) & OUTP(L, C) & D(1), D(1) & .Cells(R, C).Value & D(1)) = 0 Then _
                            OUTP(L, C) = OUTP(L, C) & D(-(OUTP(L, C) > "")) & .Cells(R, C).Value
        Next
    Next
End With

[D3:E3].Resize(UBound(OUTP)).Value = OUTP
With Cells(1).CurrentRegion.Columns("D:E"):  .HorizontalAlignment = xlCenter:  .AutoFit:  End With
Application.Goto Cells(1), True
End Sub

The advanced filter creates in output worksheet unique elements
from the source 3 columns.
Then arrays SPTM (unique concatenated keys from this 3 columns)
and OUTP (output array of columns D & E) are sized to the output rows number.

Marc L · Sep 18, 2015

To concatenate, we often use & operator …
With many elements from a row to concatenate,
we can use Join VBA function with a one dimension array.
But 'cause a range of cells is a two dimensions array, we need to arrange
data to a one dimension array. For example two ways :
a double Transpose worksheet function or using Index worksheet function.
Index could be a trap. Works fast with few data but the more source data
rows, the slower ! Tip with this function is to only use a couple of rows as
range from source data. For example to extract row #11,
range of Index could be rows #11 & 12 and 1 as row of Index to extract
(see its Excel help) …

Next code is a mod of previous one using double Transpose function
but in comments are Index codelines :

Code:

Sub DemoH2()
Application.ScreenUpdating = False
 
With Cells(1).CurrentRegion.Rows
    If .Count > 2 Then .Item("3:" & .Count).Clear
End With
 
With Sheet1.Cells(1).CurrentRegion.Rows
    If .Count < 3 Then Exit Sub
    .Item("2:" & .Count).Columns("A:C").AdvancedFilter xlFilterCopy, , [A2:C2], True
 
    With Cells(1).CurrentRegion.Rows
        With .Item("3:" & .Count).Columns("A:C").Rows
             .Borders.LineStyle = xlLineStyleNone:  .Font.Size = 11
            ReDim SPTM$(1 To .Count), OUTP$(1 To .Count, 4 To 5)
            For L& = 1 To .Count:  SPTM(L) = Join$(Application.Transpose(Application.Transpose(.Item(L).Value)), "¤"):  Next
'           For L& = 1 To .Count:  SPTM(L) = Join$(Application.Index(.Item(L).Resize(2).Value, 1), "¤"):  Next
        End With
    End With
                            D = Array("", ", ")
    For R& = 3 To .Count
         L = Application.Match(Join(Application.Transpose(Application.Transpose(.Item(R).Columns("A:C").Value)), "¤"), SPTM, 0)
'        L = Application.Match(Join(Application.Index(.Item(R).Resize(2).Columns("A:C").Value, 1), "¤"), SPTM, 0)
        For C% = 4 To 5
            If InStr(D(1) & OUTP(L, C) & D(1), D(1) & .Cells(R, C).Value & D(1)) = 0 Then _
                            OUTP(L, C) = OUTP(L, C) & D(-(OUTP(L, C) > "")) & .Cells(R, C).Value
        Next
    Next
End With
 
[D3:E3].Resize(UBound(OUTP)).Value = OUTP
With Cells(1).CurrentRegion.Columns("D:E"):  .HorizontalAlignment = xlCenter:  .AutoFit:  End With
Application.Goto Cells(1), True
End Sub

Marc L · Sep 19, 2015

With big data, using Dictionary object is very often the fastest way.
It's an easy object, near a Collection but improved
with some methods and properties like Exists method.
Valid dictionary in VBA search box or look at MSDN website.

As usual, paste code to output worksheet module :

Code:

Sub DemoDict1()
    Const DL = ", "
      Dim Dict As Object, SP$()
With Cells(1).CurrentRegion.Rows
    If .Count > 2 Then .Item("3:" & .Count).Clear
End With
  
With Sheet1.Cells(1).CurrentRegion.Rows
    If .Count < 3 Then Beep: Exit Sub
    Application.ScreenUpdating = False
                      Set Dict = CreateObject("Scripting.Dictionary")
    For R& = 3 To .Count
        With .Item(R)
            K$ = .Cells(1).Value & vbTab & .Cells(2).Value & vbTab & .Cells(3).Value
                      SP = Split(Dict.Item(K), vbTab)
            If UBound(SP) > 0 Then
                For C% = 0 To 1
                 If InStr(DL & SP(C) & DL, DL & .Cells(4 + C).Value & DL) = 0 Then _
                       SP(C) = SP(C) & DL & .Cells(4 + C).Value
                Next
                Dict.Item(K) = Join$(SP, vbTab)
            Else
                Dict.Item(K) = .Cells(4).Value & vbTab & .Cells(5).Value
            End If
        End With
    Next
End With
  
With [A3].Resize(Dict.Count)
    .Value = Application.Transpose(Dict.Keys):   .TextToColumns DataType:=xlDelimited, Tab:=True
End With
  
With [D3].Resize(Dict.Count)
    .Value = Application.Transpose(Dict.Items):  .TextToColumns DataType:=xlDelimited, Tab:=True
End With
  
With [D2:E2].Resize(Dict.Count + 1):  .HorizontalAlignment = xlCenter:  .Columns.AutoFit:  End With
                     Dict.RemoveAll:              Set Dict = Nothing
    Application.Goto Cells(1), True
End Sub

Without using Add neither Exists Dictionary methods,
as revealed in the help of its Item property …

Output data are stored within the Dictionary object :
columns A:C concatenated as keys, columns D:E concatenated as items …

Transpose worksheet function is limited to 65536 items
(depends on Excel version).

Marc L · Sep 19, 2015

Fastest could be to combine a source data array and a dictionary :

Code:

Sub DemoDict2()
    Const DL = ", "
With Sheet1.Cells(1).CurrentRegion.Rows
    If .Count < 3 Then Beep: Exit Sub
    VA = .Item("3:" & .Count).Value
End With
  
With Cells(1).CurrentRegion.Rows
    Application.ScreenUpdating = False
    If .Count > 2 Then .Item("3:" & .Count).Clear
End With
  
With CreateObject("Scripting.Dictionary")
    For R& = 1 To UBound(VA)
        K$ = VA(R, 1) & vbTab & VA(R, 2) & vbTab & VA(R, 3)
                  SP = Split(.Item(K), vbTab)
        If UBound(SP) > 0 Then
            For C% = 0 To 1
                T$ = VA(R, 4 + C)
                If IsError(Application.Match(T, Split(SP(C), DL), 0)) Then SP(C) = SP(C) & DL & T
            Next
            .Item(K) = Join$(SP, vbTab)
        Else
            .Item(K) = VA(R, 4) & vbTab & VA(R, 5)
        End If
    Next
         [A3].Resize(.Count).Value = Application.Transpose(.Keys)
         [D3].Resize(.Count).Value = Application.Transpose(.Items)
        .RemoveAll
End With
  
With Cells(1).CurrentRegion.Rows
    With .Item("3:" & .Count)
        For Each VA In [{1,4}]:  .Columns(VA).TextToColumns , xlDelimited, , , True:  Next
    End With
    With .Columns("D:E"):  .HorizontalAlignment = xlCenter:  .AutoFit:  End With
    Application.Goto .Cells(1), True
End With
End Sub

Back to compare with Match worksheet function
with the ghost tip to guess, to end the loop …

With small data, whatever the way, it should be fast.
Choose first the way you are comfortable with,
the easier for you to amend in case of an update.

Reminder : these alternative ways do not need source data sorted
unlike easy demos …

ThrottleWorks · Sep 21, 2015

Hi @Marc L , what can say about your efforts. Saying 'thank you' will be a formality still thanks a lot for the help and your valuable time.

I am going through your posts. Will revert with details. Have a nice day ahead.

Marc L · Sep 21, 2015

Thanks for these kind words !
It's a really a pleasure to see OP like you which wants to learn …

Another little concern with the Transpose worksheet function :
may not work with string upper to 255 characters …

Luke M · Sep 21, 2015

Very well done Marc. This certainly became one of those challenges that was trickier than initial appearance.

Marc L · Sep 21, 2015

Thanks Ninja !

The way using Match Excel worksheet function is to remind for MAC users
as Dictionary is a Windows object …

How to combine duplicate entries in one cell

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja

Excel Ninja