How to combine duplicate entries in one cell

[ThrottleWorks]

Hi @Luke M Sir,

Sorry to disturb you again on this.

I am facing problem with "wsDest.Cells(outputRow, 5).Value = Left(strCode, Len(strCode) - Len(deLim))" of the below mentioned code.

When I have volume as mentioned below I am getting result as
"
4,354,414,495,666,590,000,000,000,000
"


Volume
435
435
441
449
566
659
665
720
761
1287

Kindly help if you get time.

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

 

[ThrottleWorks]

Hi @Luke M Sir, If I prefix the value with a text, the problem seems to be vanished. Not sure about this, still in checking phase.

KTM1111
KTM1112
KTM1113
KTM1114
KTM1115
KTM1116
KTM1117
KTM1118
KTM1119
KTM1120

 

[ThrottleWorks]

My mistake, it is not resolved yet.

 

[ThrottleWorks]

Hi @Luke M Sir, the issue seems to be resolved (finally).

First I prefix "KTM" with volume then I replaced this prefix with blank.
I also changed 'Const deLim As String = "," to Const deLim As String = " , ".
Included extra space before and after ",".

If I do not add space in string, then replaced value are again turned in to invalid values. I do not know the reason yet, I will try to find out.

Thanks a lot. Have a nice day ahead.

PS - Sir, sorry for the personal question, hope you do not mind me asking.
Have you moved from Australia to US. (you can choose to ignore this question).

 

[Luke M]

Glad you got it sorted out.

I've always been an American, my friend. Perhaps you're thinking of Hui? Or Jeff Weir (New Zealander)

 

[ThrottleWorks]

Hi @Luke M Sir, my bad, do not know why I used to think that both you and Hui Sir are from Australia (correct about Hui Sir only).

And I used to always greet you exactaly opposite, good night instead of good morning.

 

[Marc L]

Hi !​

Included extra space before and after ",".

Can you try just with a space after the comma ?
Did you try same data with an EasyDemo ?

Comma alone could be a trap with numbers …
For only one character delimiter, you could replace comma
by a semicolon or a special space : deLim = Chr$(160) …
​

 

[ThrottleWorks]

Hi @Marc L ,

Can you try just with a space after the comma ?

I tried above, it's working ! No need to use pre-fix either. Also it look visually better (and correct)

I can not use ; symbol. Will not be allowed.

Did you try same data with an EasyDemo ?

Sorry Marc, did not get time to work/study your code, bit busy since last week.

However I will be definitely doing it, will revert with details.

Yesterday night I read your code and explanations partially.