Split a string using comma and combine withput duplicates

[Balajibenz]

Hi People,

Can you help me with below analysis using a VBA code.

I have the sheet with below input in sheet1. It basically has two columns. Column A has ID and B has its category. an ID might have multiple lines and multiple categories each separated by comma. the possible categories are - Production, Development, Testing, UserAcceptanceTest, Staging, DisasterRecovery.

Book1
	A	B
1	ID	Category 1
2	100	Production, Production, Production
3	100	Production, Development, Production, Development
4	128	Production
5	115	Development, UserAcceptanceTest, UserAcceptanceTest
6	115	Production, Staging, Staging
7	136	UserAcceptanceTest, Production, DisasterRecovery
Sheet1

what i am lookin for is to have a single line items for each ID and in the category column all the categories under ID should be refelcting each separated by Comma with out any duplicates in sheet 2 as shown below.

Book1
	A	B
1	ID	Category 2
2	100	Production, Development, Testing
3	128	Production
4	115	Development, UserAcceptanceTest, Production, Staging
5	136	UserAcceptanceTest, Production, DisasterRecovery
Sheet2

I have few lines but my original data has many and I am unable to attach it due to access issues. also original data will have many duplicates in categroy column (up to 50 each seperated by comma ). Thank you in advance for helping me put.

 

[Fluff]

How about

Sub Balajibenz()
   Dim Cl As Range
   Dim Dic As Object
   Dim Sp As Variant
   Dim i As Long
   
   Set Dic = CreateObject("Scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Sp = Split(Cl.Offset(, 1).Value, ",")
         For i = 0 To UBound(Sp)
            If Not Dic.exists(Cl.Value) Then Dic.Add Cl.Value, Trim(Sp(i))
            If InStr(1, Dic(Cl.Value), Trim(Sp(i)), 1) = 0 Then
               Dic(Cl.Value) = Dic(Cl.Value) & ", " & Trim(Sp(i))
            End If
         Next i
      Next Cl
   End With
   Sheets("Sheet2").Range("A2").Resize(Dic.Count, 2).Value = Application.Transpose(Array(Dic.keys, Dic.items))
End Sub

 

[Balajibenz]

How about

Sub Balajibenz()
   Dim Cl As Range
   Dim Dic As Object
   Dim Sp As Variant
   Dim i As Long
  
   Set Dic = CreateObject("Scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Sp = Split(Cl.Offset(, 1).Value, ",")
         For i = 0 To UBound(Sp)
            If Not Dic.exists(Cl.Value) Then Dic.Add Cl.Value, Trim(Sp(i))
            If InStr(1, Dic(Cl.Value), Trim(Sp(i)), 1) = 0 Then
               Dic(Cl.Value) = Dic(Cl.Value) & ", " & Trim(Sp(i))
            End If
         Next i
      Next Cl
   End With
   Sheets("Sheet2").Range("A2").Resize(Dic.Count, 2).Value = Application.Transpose(Array(Dic.keys, Dic.items))
End Sub

Hi Fluff,

Thank you so much, That works perfectly except that if an id has category as empty it is not being published in sheet2. (Sorry that i missed to mention the scenario where category is empty). in that case can you help me to get the ID's to sheet2 with category as empty.

Just one more thing if possible. is it possible produce the result in sheet1 in column "C" without removing duplicates in Column "A". Thanks again mate

 

[Fluff]

This will do the 1st part

Sub Balajibenz()
   Dim Cl As Range
   Dim Dic As Object
   Dim Sp As Variant
   Dim i As Long
   
   Set Dic = CreateObject("Scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Not Dic.exists(Cl.Value) Then Dic.Add Cl.Value, ""
         Sp = Split(Cl.Offset(, 1).Value, ",")
         For i = 0 To UBound(Sp)
            If Dic(Cl.Value) = "" Then Dic(Cl.Value) = Trim(Sp(i))
            If InStr(1, Dic(Cl.Value), Trim(Sp(i)), 1) = 0 Then
               Dic(Cl.Value) = Dic(Cl.Value) & ", " & Trim(Sp(i))
            End If
         Next i
      Next Cl
   End With
   Sheets("Sheet2").Range("A2").Resize(Dic.Count, 2).Value = Application.Transpose(Array(Dic.keys, Dic.items))
End Sub

 

[Balajibenz]

This will do the 1st part

Sub Balajibenz()
   Dim Cl As Range
   Dim Dic As Object
   Dim Sp As Variant
   Dim i As Long
  
   Set Dic = CreateObject("Scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Not Dic.exists(Cl.Value) Then Dic.Add Cl.Value, ""
         Sp = Split(Cl.Offset(, 1).Value, ",")
         For i = 0 To UBound(Sp)
            If Dic(Cl.Value) = "" Then Dic(Cl.Value) = Trim(Sp(i))
            If InStr(1, Dic(Cl.Value), Trim(Sp(i)), 1) = 0 Then
               Dic(Cl.Value) = Dic(Cl.Value) & ", " & Trim(Sp(i))
            End If
         Next i
      Next Cl
   End With
   Sheets("Sheet2").Range("A2").Resize(Dic.Count, 2).Value = Application.Transpose(Array(Dic.keys, Dic.items))
End Sub

That worked perfectly Fluff. Thank you so much

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Balajibenz]

You're welcome & thanks for the feedback.

This will do the 1st part

Sub Balajibenz()
   Dim Cl As Range
   Dim Dic As Object
   Dim Sp As Variant
   Dim i As Long
  
   Set Dic = CreateObject("Scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Not Dic.exists(Cl.Value) Then Dic.Add Cl.Value, ""
         Sp = Split(Cl.Offset(, 1).Value, ",")
         For i = 0 To UBound(Sp)
            If Dic(Cl.Value) = "" Then Dic(Cl.Value) = Trim(Sp(i))
            If InStr(1, Dic(Cl.Value), Trim(Sp(i)), 1) = 0 Then
               Dic(Cl.Value) = Dic(Cl.Value) & ", " & Trim(Sp(i))
            End If
         Next i
      Next Cl
   End With
   Sheets("Sheet2").Range("A2").Resize(Dic.Count, 2).Value = Application.Transpose(Array(Dic.keys, Dic.items))
End Sub

Hi Fluff,

Can you help me with one more add on to above.in column C I want to categorize based on the categories in B. For example if it is empty then it should be "NO" in column C and if column B has single category then we can have same in column C.
I have few other combinations so can you help me with a template of AND/OR conditions syntax which I can use to fill with all the conditions I have. Thanks again mate.

Something like below.

If column B contains xxx AND xxx AND xxxx then column C. Value = yyyy
Else
column B contains xxx AND xxx OR xxxx then column C. Value = yyyy

 

[Fluff]

You have already started a new thread for this.

 

[Balajibenz]

You have already started a new thread for this.

Yes mate but sadly no one helped me on that yet??