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]

Welcome to the forum

What does combine mean ? What is the expected result for ?
3222000011 (has A & B)
3222002011 (has A & B & C)

Do you want ..
Column A: 3222000011 Column B: A+B
Column A: 3222002011 Column B: A+B+C

 

[farhan11941234]

in column C Result Should be A+B 3222000011 and 3222002011 Column B: A+B+C through VBA

 

[farhan11941234]

and remove Duplicates Rows

 

[Yongle]

So will column A be identical to column C ?

 

[farhan11941234]

tow entries in column A 32220000011 but Product Cell B2 Value is A and B3 Value B
i Want in C Column A+B and then remove 2nd Duplicate value i.e Row 3 and same pattern goes down to all rows and only unique value remains

 

[farhan11941234]

Please see the image

 

[Yongle]

thanks for clarification
will update thread later today

 

[Yongle]

Notes
1. Data should be in columns A & B with headers in A1:B1
2. Run macro from sheet containing the data

Result sheet:

Book1
	A	B	C
1	ID #	Product	Combine Products
2	100001	A	A+B
3	100002	A	A+B+C
4	100003	A	A+B+C+D
5	100004	A	A+B
6	100005	A	A
7	100006	B	B
8	100007	C	C
Sheet1 (2)

Source sheet:

Book1
	A	B
1	ID #	Product
2	100008	E
3	100008	D
4	100003	D
5	100008	C
6	100007	C
7	100003	C
8	100002	C
9	100008	B
10	100006	B
11	100004	B
12	100003	B
13	100002	B
14	100001	B
15	100008	A
16	100005	A
17	100004	A
18	100003	A
19	100002	A
20	100001	A
Sheet1

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, 3) = "Combine Products"
    ws.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
'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:B")
        .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(, 2)
        Else
            MainStr = MainStr & "+" & ProdStr   
        End If
        If Cel.Offset(1) <> Cel Then Prod = MainStr
    Next Cel
'remove unwnated rows
    Set Prod = ws.Cells(ws.Rows.Count, 3)
    For Each Cel In Rng.Offset(, 2)
        If Cel = "" Then Set Prod = Union(Prod, Cel)
    Next Cel
    Prod.EntireRow.Delete
End Sub

 

[farhan11941234]

thanks for this nice sub seems working, i will update you shortly....