Comibed Prouct and delete duplicate

[farhan11941234]

In Id Column there are duplicate entries but product column is different. i want to combine product line A or A+B or A+B+C in next column and delete duplicates entries in column A.
please see snapshot of spreadsheet.

 

[Yongle]

data in columns C:F is required

I know that

BUT

Using your first 2 rows as illustration
100001 A John 123 345 (no rate in Column E)
100001 B John 123 2 345 (rate 2 in column E)


Output required is
100001 A+B John 123 2 345 (rate from B ?? why ??)


how does VBA know it is not this ?
100001 A+B John 123 345 (no rate)

 

[farhan11941234]

Rate has value only if Product Has B Value, just a thought if we combined the product first then remove the rows where duplicates Id has product A and C and Unique remains the same.

 

[Yongle]

Try this

Sub farhan11941234()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, Cel As Range, Rng As Range, Prod As Range, F As Long, Addr As String
    Dim MainStr As String, ProdStr As String
  
 'copy to new sheet and remove duplicates
    ActiveSheet.Copy Before:=Sheets(1)
    Set ws = Sheets(1)
    ws.Cells(1, 7) = "Combine Products"
'sort data by ID and then by Product
    With ws.Sort
        .SortFields.Add Key:=Range("A1"), Order:=xlAscending
        .SortFields.Add Key:=Range("B1"), Order:=xlAscending
        .SetRange Range("A:G")
        .Header = xlYes
        .Apply
    End With
'concatenate strings
    Set Rng = ws.Range("A2", ws.Range("A" & ws.Rows.Count).End(xlUp))
    For Each Cel In Rng
        ProdStr = Cel.Offset(, 1)
        If WorksheetFunction.CountIf(ws.Range("A2", Cel), Cel) = 1 Then
            MainStr = ProdStr
            Set Prod = Cel.Offset(, 6)
        Else
            MainStr = MainStr & "+" & ProdStr
            'reset where to write values to
            If Cel.Offset(, 1) = "B" Then Set Prod = Cel.Offset(, 6)
        End If
        If Cel.Offset(1) <> Cel Then Prod = MainStr
    Next Cel
'remove unwnated rows
    Set Prod = ws.Cells(ws.Rows.Count, 7)
    For Each Cel In Rng.Offset(, 6)
        If Cel = "" Then Set Prod = Union(Prod, Cel)
    Next Cel
    Prod.EntireRow.Delete
'place returned combined values in column B
    Rng.Offset(, 1).Value = Rng.Offset(, 6).Value
    ws.Range("G1").EntireColumn.Delete
End Sub

This is how the cell for combined values is reset If there any entries for product B for an ID

            If Cel.Offset(, 1) = "B" Then Set Prod = Cel.Offset(, 6)

Result based on data supplied

Book1
	A	B	C	D	E	F	G
1	ID	Product	Name	Addrss	Rate	Cell No
2	100001	A+B	John	123	2	345
3	100002	A+B+C	Bill	xyz	2	321
4	100003	A+B+C	Will	Asd	4	301
5	100004	A+B	Harry	Ghq	6	300
6	100005	A	Superman	jkl		390
7	100006	A	Batman	mno		287
8	100007	A	Joker	qwe		210
9	100008	A+B+C	Alen	Poiuy	8	654
10
Sheet4 (14)

 

[farhan11941234]

Thanks for your time and effort

 

[farhan11941234]

appreciate your work, problem is solved.