• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to combine duplicate entries in one cell

ThrottleWorks

ThrottleWorks

Excel Ninja
Hi,

Please refer attached file for details. Please help if possible. Thanks.

In Column A I have name of ‘Sale Person’, Column B has Team, Column C has ‘Model’.

If all these three parameter are matching, then we need to club these lines in to 1.

For example, range A3 till A7 are records for same set of values, that is all the sales person, team and model are matching.

So I have combined it in Range G3:K3. Also, D6 and D7 have same values so I will mention them only once while combining.

Please refer cell J3 for details.

For range A11:C12 all the parameters are matching, also volume is different in both D11 and D12.

So we have mentioned it in a single line in range G6:K6.
 

Attachments

  • Chandoo.xls
    24.5 KB · Views: 18
Last edited:
Hi Throttle,

While I understand combining the duplicate records, it looks like Code should be a identifier as well. Further, XL and date mining doesn't really work well when you try to combine data together using commas like in your example K3 cell. Perhaps a PivotTable would be a better solution?
upload_2015-9-14_11-12-36.png

Can easily see now how things are grouped, and Code is still a unique identifier. If code is not needed, rolls up even smaller:
upload_2015-9-14_11-13-17.png
 
Hi @Luke M Sir, thanks a lot for the help. I require this data for further processing and presentation so though Pivot is a good option I won't be able to use it.

I am trying taking concat of "=A3&B3&C3&D3" , remove duplicate, de-limit data, populate values based on this. Not successful yet, will revert with details.

Good night. :)
 

Attachments

  • Chandoo.xls
    26 KB · Views: 4
Last edited:
can you use macros or UDF? The native concatenation function in XL is pitiful, but there are several more powerful options out there (or we can build).

Or, do you just want a straight up macro to organize the data? If so, is all the data nicely sorted like in your example, or could similar entries be scattered throughout?
 
Hi @Luke M Sir, thanks a lot for the help.

do you just want a straight up macro to organize the data
Click to expand...
Yes, I am trying for macro.

I just tried something, sort A, B and C.
Concat A,B and C in new column. Use if condition to check duplicate.
Highlight duplicate with a color, run a loop to remove duplicates.

Now, the challange is, how do I insert multiple Volume in one cell.
One idea is to find in string search and check if the volume is already present in newly created cell, if not then capture else leave it.

I have not tried instring part yet, will revert with details.

PS - Yes Sir, the data look simple, I guess I will be able to sort it.
Should not face issues with that.
 
How's this then? As you indicated, assumption is that data is sorted first.
Code: 
Sub Consolidate()
Dim wsDest As Worksheet
Dim wsSource As Worksheet
Dim lastRow As Long
Dim curRow As Long
Dim outputRow As Long
Dim startRow As Long
Const deLim As String = ","
Dim strName As String
Dim strTeam As String
Dim strModel As String
Dim strVol As String
Dim strCode As String


'===========
'ASSUMPTION
'Data has been sorted before running macro
'===========

'Define our sheets
Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Set wsDest = ThisWorkbook.Worksheets.Add

Application.ScreenUpdating = False

outputRow = 3
startRow = 3
With wsSource
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   
    'Load initial values
    strName = .Cells(startRow, 1).Value
    strTeam = .Cells(startRow, 2).Value
    strModel = .Cells(startRow, 3).Value
    strVol = .Cells(startRow, 4).Value & deLim
    strCode = .Cells(startRow, 5).Value & deLim
   
   
    For curRow = startRow + 1 To lastRow - 1
        If .Cells(curRow, 1).Value = strName And _
            .Cells(curRow, 2).Value = strTeam And _
            .Cells(curRow, 3).Value = strModel Then
           
            strVol = strVol & .Cells(curRow, 4).Value & deLim
            strCode = strCode & .Cells(curRow, 5).Value & deLim
           
        Else
            wsDest.Cells(outputRow, 1).Value = strName
            wsDest.Cells(outputRow, 2).Value = strTeam
            wsDest.Cells(outputRow, 3).Value = strModel
            wsDest.Cells(outputRow, 4).Value = Left(strVol, Len(strVol) - Len(deLim))
            wsDest.Cells(outputRow, 5).Value = Left(strCode, Len(strCode) - Len(deLim))
            outputRow = outputRow + 1
           
            strName = .Cells(curRow, 1).Value
            strTeam = .Cells(curRow, 2).Value
            strModel = .Cells(curRow, 3).Value
            strVol = .Cells(curRow, 4).Value & deLim
            strCode = .Cells(curRow, 5).Value & deLim
        End If
    Next curRow
   
    'Capture last row
    wsDest.Cells(outputRow, 1).Value = strName
    wsDest.Cells(outputRow, 2).Value = strTeam
    wsDest.Cells(outputRow, 3).Value = strModel
    wsDest.Cells(outputRow, 4).Value = Left(strVol, Len(strVol) - Len(deLim))
    wsDest.Cells(outputRow, 5).Value = Left(strCode, Len(strCode) - Len(deLim))
End With

'Setup output sheet
With wsDest
    .Range("A1").Value = "Output"
    .Range("A2:E2").Value = wsSource.Range("A2:E2").Value
    .Range("A:E").EntireColumn.AutoFit
    .Range("A:E").HorizontalAlignment = xlLeft
End With
Application.Goto wsDest.Range("A1")

Application.ScreenUpdating = True
   
End Sub
 
Hi @Luke M Sir, thanks a lot for such a wonderful code !

The code is working nice however there seems to be 1 glitch.
Please correct me if I am wrong, kindly check the attached file.

Ideally value in range D3 (Sheet 7) should be 1,2 however it is populated as 1,2,2.

If we check value in D4, it's correct.

Once again thanks a lot for the help, please look into the issue if you have time.

Have a nice day ahead. :)

PS - I forgot to mention, the code is taking unique values from the range perfectly !
 

Attachments

  • Chandoo.xls
    39 KB · Views: 9
Last edited:
Hmm. There was a mistake, but the bigger one is actually the other way. In your file, E4 is incorrect as it's missing the last row's volume #. If I first correct the code to correct that mistake, then we get:
upload_2015-9-15_8-43-21.png

As to your question, I think my response would be a caution. If you summarize the volume, you risk causing confusion. Let's say there were 4 rows of data, same name/team/model, with this
volume | code
1 10
2 30
2 20
3 10

doing what you suggest, the output would look like:
1,2,3 | 10,30,20,10
The problem now is, you have 4 codes, and you can't tell which volume number they align with. Did the 2 have two codes? Or was it the 3? If we keep the code the current way, you always have a 1-to-1 match up, so you can still tell what your volumes were.

Or, do we not really care which volume goes with which code?


PS. Corrected code for last row
Code: 
Sub Consolidate()
Dim wsDest As Worksheet
Dim wsSource As Worksheet
Dim lastRow As Long
Dim curRow As Long
Dim outputRow As Long
Dim startRow As Long
Const deLim As String = ","
Dim strName As String
Dim strTeam As String
Dim strModel As String
Dim strVol As String
Dim strCode As String
Dim lastMatch As Boolean

'===========
'ASSUMPTION
'Data has been sorted before running macro
'===========

'Define our sheets
Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Set wsDest = ThisWorkbook.Worksheets.Add

Application.ScreenUpdating = False

outputRow = 3
startRow = 3
With wsSource
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   
    'Load initial values
   strName = .Cells(startRow, 1).Value
    strTeam = .Cells(startRow, 2).Value
    strModel = .Cells(startRow, 3).Value
    strVol = .Cells(startRow, 4).Value & deLim
    strCode = .Cells(startRow, 5).Value & deLim
   
   
    For curRow = startRow + 1 To lastRow
        If .Cells(curRow, 1).Value = strName And _
            .Cells(curRow, 2).Value = strTeam And _
            .Cells(curRow, 3).Value = strModel Then
           
            strVol = strVol & .Cells(curRow, 4).Value & deLim
            strCode = strCode & .Cells(curRow, 5).Value & deLim
           lastMatch = True
        Else
            wsDest.Cells(outputRow, 1).Value = strName
            wsDest.Cells(outputRow, 2).Value = strTeam
            wsDest.Cells(outputRow, 3).Value = strModel
            wsDest.Cells(outputRow, 4).Value = Left(strVol, Len(strVol) - Len(deLim))
            wsDest.Cells(outputRow, 5).Value = Left(strCode, Len(strCode) - Len(deLim))
            outputRow = outputRow + 1
           
            strName = .Cells(curRow, 1).Value
            strTeam = .Cells(curRow, 2).Value
            strModel = .Cells(curRow, 3).Value
            strVol = .Cells(curRow, 4).Value & deLim
            strCode = .Cells(curRow, 5).Value & deLim
            lastMatch = False
        End If
    Next curRow
   
    'Capture last row
    If lastMatch Then
    wsDest.Cells(outputRow, 1).Value = strName
     wsDest.Cells(outputRow, 2).Value = strTeam
     wsDest.Cells(outputRow, 3).Value = strModel
     wsDest.Cells(outputRow, 4).Value = Left(strVol, Len(strVol) - Len(deLim))
     wsDest.Cells(outputRow, 5).Value = Left(strCode, Len(strCode) - Len(deLim))
    End If
End With

'Setup output sheet
With wsDest
    .Range("A1").Value = "Output"
    .Range("A2:E2").Value = wsSource.Range("A2:E2").Value
    .Range("A:E").EntireColumn.AutoFit
    .Range("A:E").HorizontalAlignment = xlLeft
End With
Application.Goto wsDest.Range("A1")

Application.ScreenUpdating = True
   
End Sub
 
Hi @Luke M Sir, there seems to some error.

I have highlighted expected result in Column F. kindly correct me if I am wrong.

Could you please check the attached file if possible.
 

Attachments

  • Chandoo.xls
    39.5 KB · Views: 8
Throttle,

First, thanks for a wonderful response. So often we get posters who say "it didn't work", but don't say what they didn't like. You took the time to say what was wrong, highlight the error, and show what you wanted. Perfect info! Again, thanks. :)

Code to include only unique code/volumes:
Code: 
Sub Consolidate()
Dim wsDest As Worksheet
Dim wsSource As Worksheet
Dim lastRow As Long
Dim curRow As Long
Dim outputRow As Long
Dim startRow As Long
Const deLim As String = ","
Dim strName As String
Dim strTeam As String
Dim strModel As String
Dim strVol As String
Dim strCode As String
Dim lastMatch As Boolean

'===========
'ASSUMPTION
'Data has been sorted before running macro
'===========

'Define our sheets
Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Set wsDest = ThisWorkbook.Worksheets.Add

Application.ScreenUpdating = False

outputRow = 3
startRow = 3
With wsSource
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   
    'Load initial values
  strName = .Cells(startRow, 1).Value
    strTeam = .Cells(startRow, 2).Value
    strModel = .Cells(startRow, 3).Value
    strVol = .Cells(startRow, 4).Value & deLim
    strCode = .Cells(startRow, 5).Value & deLim
   
   
    For curRow = startRow + 1 To lastRow
        If .Cells(curRow, 1).Value = strName And _
            .Cells(curRow, 2).Value = strTeam And _
            .Cells(curRow, 3).Value = strModel Then
           
            'check if value already logged
            If Not (InStr(1, strVol, .Cells(curRow, 4), vbBinaryCompare) > 0) Then
                strVol = strVol & .Cells(curRow, 4).Value & deLim
            End If
            If Not (InStr(1, strCode, .Cells(curRow, 5), vbBinaryCompare) > 0) Then
                strCode = strCode & .Cells(curRow, 5).Value & deLim
            End If
           lastMatch = True
        Else
            wsDest.Cells(outputRow, 1).Value = strName
            wsDest.Cells(outputRow, 2).Value = strTeam
            wsDest.Cells(outputRow, 3).Value = strModel
            wsDest.Cells(outputRow, 4).Value = Left(strVol, Len(strVol) - Len(deLim))
            wsDest.Cells(outputRow, 5).Value = Left(strCode, Len(strCode) - Len(deLim))
            outputRow = outputRow + 1
           
            strName = .Cells(curRow, 1).Value
            strTeam = .Cells(curRow, 2).Value
            strModel = .Cells(curRow, 3).Value
            strVol = .Cells(curRow, 4).Value & deLim
            strCode = .Cells(curRow, 5).Value & deLim
            lastMatch = False
        End If
    Next curRow
   
    'Capture last row
   If lastMatch Then
    wsDest.Cells(outputRow, 1).Value = strName
     wsDest.Cells(outputRow, 2).Value = strTeam
     wsDest.Cells(outputRow, 3).Value = strModel
     wsDest.Cells(outputRow, 4).Value = Left(strVol, Len(strVol) - Len(deLim))
     wsDest.Cells(outputRow, 5).Value = Left(strCode, Len(strCode) - Len(deLim))
    End If
End With

'Setup output sheet
With wsDest
    .Range("A1").Value = "Output"
    .Range("A2:E2").Value = wsSource.Range("A2:E2").Value
    .Range("A:E").EntireColumn.AutoFit
    .Range("A:E").HorizontalAlignment = xlLeft
End With
Application.Goto wsDest.Range("A1")

Application.ScreenUpdating = True
   
End Sub
 
Hi @Luke M sir, thanks a lot for your kind words.

Extremely sorry for trying your patience with my problem, it’s working perfectly.
Thanks a lot for your help and valuable time. Good night. :)
 

Attachments

  • Chandoo.xls
    43 KB · Views: 8
Hi @Luke M Sir, I am back to trouble you again (with your permission).

It seems macro is not considering records from the last row. I will upload a sample file shortly.

If you could please delete row (4:7) from the previously attached file, we will have only 2 records.

Dravid and VVS, however the macro returns result only for Dravid and leaves out VVS.

Could you please look into this if possible. Good night. :)
PS - Please find attached file for your reference.

I tried "curRow = startRow + 1 To lastRow" changing to "curRow = startRow To lastRow" but was not able to get the results with this also.
 

Attachments

  • Chandoo.xls
    39 KB · Views: 11
Last edited:
Man, I must need more caffeine! :rolleyes:

Try this.
Code: 
Sub Consolidate()
Dim wsDest As Worksheet
Dim wsSource As Worksheet
Dim lastRow As Long
Dim curRow As Long
Dim outputRow As Long
Dim startRow As Long
Const deLim As String = ","
Dim strName As String
Dim strTeam As String
Dim strModel As String
Dim strVol As String
Dim strCode As String

'===========
'ASSUMPTION
'Data has been sorted before running macro
'===========

'Define our sheets
Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Set wsDest = ThisWorkbook.Worksheets.Add

Application.ScreenUpdating = False

outputRow = 3
startRow = 3
With wsSource
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   
    'Load initial values
 strName = .Cells(startRow, 1).Value
    strTeam = .Cells(startRow, 2).Value
    strModel = .Cells(startRow, 3).Value
    strVol = .Cells(startRow, 4).Value & deLim
    strCode = .Cells(startRow, 5).Value & deLim
   
   
    For curRow = startRow + 1 To lastRow
        If .Cells(curRow, 1).Value = strName And _
            .Cells(curRow, 2).Value = strTeam And _
            .Cells(curRow, 3).Value = strModel Then
           
            'check if value already logged
           If Not (InStr(1, strVol, .Cells(curRow, 4), vbBinaryCompare) > 0) Then
                strVol = strVol & .Cells(curRow, 4).Value & deLim
            End If
            If Not (InStr(1, strCode, .Cells(curRow, 5), vbBinaryCompare) > 0) Then
                strCode = strCode & .Cells(curRow, 5).Value & deLim
            End If

        Else
            wsDest.Cells(outputRow, 1).Value = strName
            wsDest.Cells(outputRow, 2).Value = strTeam
            wsDest.Cells(outputRow, 3).Value = strModel
            wsDest.Cells(outputRow, 4).Value = Left(strVol, Len(strVol) - Len(deLim))
            wsDest.Cells(outputRow, 5).Value = Left(strCode, Len(strCode) - Len(deLim))
            outputRow = outputRow + 1
           
            strName = .Cells(curRow, 1).Value
            strTeam = .Cells(curRow, 2).Value
            strModel = .Cells(curRow, 3).Value
            strVol = .Cells(curRow, 4).Value & deLim
            strCode = .Cells(curRow, 5).Value & deLim

        End If
    Next curRow
   
    'Capture last row
    wsDest.Cells(outputRow, 1).Value = strName
     wsDest.Cells(outputRow, 2).Value = strTeam
     wsDest.Cells(outputRow, 3).Value = strModel
     wsDest.Cells(outputRow, 4).Value = Left(strVol, Len(strVol) - Len(deLim))
     wsDest.Cells(outputRow, 5).Value = Left(strCode, Len(strCode) - Len(deLim))

End With

'Setup output sheet
With wsDest
    .Range("A1").Value = "Output"
    .Range("A2:E2").Value = wsSource.Range("A2:E2").Value
    .Range("A:E").EntireColumn.AutoFit
    .Range("A:E").HorizontalAlignment = xlLeft
End With
Application.Goto wsDest.Range("A1")

Application.ScreenUpdating = True
   
End Sub
 
Hi !

Sorry, I'm a bit late but when I read duplicate I heard dictionary !

According to very first attachment, MATCH Excel worksheet function
checks if any item exists in array used as an inner dictionary :​
Code: 
Sub Demo1()
Const DL = ", "

With Sheet1.Cells(1).CurrentRegion.Rows
    If .Count < 3 Then Beep: Exit Sub
    VA = .Item("3:" & .Count).Value
End With

ReDim SPTM$(1 To UBound(VA)), OUTP$(1 To UBound(VA), 1 To UBound(VA, 2))

For R& = 1 To UBound(VA)
              K$ = VA(R, 1) & "¤" & VA(R, 2) & "¤" & VA(R, 3)
               V = Application.Match(K, SPTM, 0)
    If IsError(V) Then
        L& = L& + 1:  SPTM(L) = K
        For C& = 1 To UBound(VA, 2):  OUTP(L, C) = VA(R, C):  Next
    Else
        For C = 4 To UBound(VA, 2)
            K = VA(R, C)
            If IsError(Application.Match(K, Split(OUTP(V, C), DL), 0)) Then OUTP(V, C) = OUTP(V, C) & DL & K
        Next
  End If
Next

With Sheet1.Cells(7).CurrentRegion.Rows
    If .Count > L + 2 Then .Item(L + 3).Resize(.Count - L - 2).Clear

    With .Item(3).Resize(L)
        .Borders.LineStyle = xlContinuous:  .Font.Size = 10
                    .Value = OUTP
    End With

    .CurrentRegion.Columns(4).Resize(, .Columns.Count - 3).AutoFit
End With
End Sub
 
Last edited:
For post #8 attachment, just mod destination worksheet :​
Code: 
Sub Demo2()
Const DL = ", "
 
With Sheet1.Cells(1).CurrentRegion.Rows
    If .Count < 3 Then Beep: Exit Sub
    VA = .Item("3:" & .Count).Value
End With
 
ReDim SPTM$(1 To UBound(VA)), OUTP$(1 To UBound(VA), 1 To UBound(VA, 2))
 
For R& = 1 To UBound(VA)
              K$ = VA(R, 1) & "¤" & VA(R, 2) & "¤" & VA(R, 3)
               V = Application.Match(K, SPTM, 0)
    If IsError(V) Then
        L& = L& + 1:  SPTM(L) = K
        For C& = 1 To UBound(VA, 2):  OUTP(L, C) = VA(R, C):  Next
    Else
        For C = 4 To UBound(VA, 2)
            K = VA(R, C)
            If IsError(Application.Match(K, Split(OUTP(V, C), DL), 0)) Then OUTP(V, C) = OUTP(V, C) & DL & K
        Next
    End If
Next
 
With Sheet7.Cells(1).CurrentRegion.Rows
    If .Count > L + 2 Then .Item(L + 3).Resize(.Count - L - 2).Clear
    .Item(3).Resize(L).Value = OUTP
    .CurrentRegion.Columns(4).Resize(, .Columns.Count - 3).AutoFit
    Application.Goto .Cells(1), True
End With
End Sub
 
Last edited:
Post #11 attachment needs to clear Sheet5 column F
and mod destination worksheet as well :​
Code: 
Sub Demo3()
Const DL = ", "
 
With Sheet1.Cells(1).CurrentRegion.Rows
    If .Count < 3 Then Beep: Exit Sub
    VA = .Item("3:" & .Count).Value
End With
 
ReDim SPTM$(1 To UBound(VA)), OUTP$(1 To UBound(VA), 1 To UBound(VA, 2))
 
For R& = 1 To UBound(VA)
              K$ = VA(R, 1) & "¤" & VA(R, 2) & "¤" & VA(R, 3)
               V = Application.Match(K, SPTM, 0)
    If IsError(V) Then
        L& = L& + 1:  SPTM(L) = K
        For C& = 1 To UBound(VA, 2):  OUTP(L, C) = VA(R, C):  Next
    Else
        For C = 4 To UBound(VA, 2)
            K = VA(R, C)
            If IsError(Application.Match(K, Split(OUTP(V, C), DL), 0)) Then OUTP(V, C) = OUTP(V, C) & DL & K
        Next
    End If
Next
 
With Sheet5.Cells(1).CurrentRegion.Rows
    If .Count > L + 2 Then .Item(L + 3).Resize(.Count - L - 2).Clear
    .Item(3).Resize(L).Value = OUTP
    .CurrentRegion.Columns(4).Resize(, .Columns.Count - 3).AutoFit
    Application.Goto .Cells(1), True
End With
End Sub
 
Last edited:
Last but not least, post #14 attachment needs to clean Sheet2
and mod Demo3 procedure Sheet5 destination worksheet to Sheet2 …

Using a dictionary, either a true external object or an inner array,
no matter to sort data …

If you read MATCH Excel help, an issue can occur using this function.
So I let you guess the ghost tip within my demonstration !​
 
Last edited:
Hi @Marc L , thanks a lot for the help and your valuable time.
Kindly allow me some time to check your macro.

Will revert with details, have a nice day ahead. :)

PS - 1,000 is just around the corner. :)
 
Hi @Luke M Sir,

The code is working perfect. I have tried possible combinations and it's working fine. Hopefully I won't disturb you more on this (especially on your birthday).

Once again thanks a lot, have a great day. Happy birthday. :)

PS - I forgot to mention earlier, Sir if you could please confirm the below if possible.

The latest macro is updated with below mentioned check.
"Dim lastMatch As Boolean" (and lines related to this check).

There are two reasons for asking this help.

1. I am trying to understand the code.
2. I have edited your code as per original table format and will be including these lines in my code.
 
Last edited:

Luke,

maybe there is a glitch with your last code but before
I need to know if your code needs a full sorted table
or just the first 3 columns as keys ?
​
 
Hi @Marc L , thanks for the help. I have told Luke Sir that only the required columns will be sorted.

Could you please share what the glitch is, I can test it here and will update you with results.
 
You must log in or register to reply here.
Back
Top