VBA code to Conactenate the data in a row by removing duplicates and sepearating it by comma.

[Balajibenz]

Hi, Can someone help me with VBA code to do the below task.

I have data in A2-Z2 where in each there will be some data. this data in each cell migh be sepearted by comma. what i am looking for is to publish a out put in AB where it concatenates data from A2-Z2 by removing duplicates and seperate each one by a comma. it should ignore if there are blanks and #N/A in between. it should be done untill last row of data in column "A". below is the example.

A	B	C	D	E	F	G	H
Development, Test	Production		Test, Production	Test, Production	#N/A​	Production	#N/A​

let us say this particular row (no:2) only has data untill H2 (hightest cell that contains data at any time would be till Z row ).

In the above case output should be Development, Test, Production as empty cells and #N/A should be ignored. thank you in advance

 

[Peter_SSs]

See if this does what you want. Test with a copy of your data.
I have assumed that your sheet does not contain any formulas.

Sub Concat_Unique()
  Dim d As Object
  Dim a As Variant, b As Variant, itm As Variant
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  
  With ActiveSheet.UsedRange
    a = .Formula
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 2 To UBound(a)
      d.RemoveAll
      For Each itm In Split(Join(Application.Index(a, i, 0), ","), ",")
        Select Case Trim(itm)
          Case "", "#N/A"
          Case Else: d(Trim(itm)) = 1
        End Select
      Next itm
      b(i, 1) = Join(d.Keys, ",")
    Next i
    .Offset(, .Columns.Count).Resize(, 1).Value = b
  End With
End Sub

Here is my sample data (A:H) and results (col I)

Balajibenz.xlsm
	A	B	C	D	E	F	G	H	I
1	A	B	C	D	E	F	G	H
2	Development, Test	Production		Test, Production	Test, Production	#N/A	Production	#N/A	Development,Test,Production
3	dog		cat, horse, donkey	cat	cat		horse,cat		dog,cat,horse,donkey
Sheet1

 

[Balajibenz]

See if this does what you want. Test with a copy of your data.
I have assumed that your sheet does not contain any formulas.

Sub Concat_Unique()
  Dim d As Object
  Dim a As Variant, b As Variant, itm As Variant
  Dim i As Long
 
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
 
  With ActiveSheet.UsedRange
    a = .Formula
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 2 To UBound(a)
      d.RemoveAll
      For Each itm In Split(Join(Application.Index(a, i, 0), ","), ",")
        Select Case Trim(itm)
          Case "", "#N/A"
          Case Else: d(Trim(itm)) = 1
        End Select
      Next itm
      b(i, 1) = Join(d.Keys, ",")
    Next i
    .Offset(, .Columns.Count).Resize(, 1).Value = b
  End With
End Sub

Here is my sample data (A:H) and results (col I)

Balajibenz.xlsm
	A	B	C	D	E	F	G	H	I
1	A	B	C	D	E	F	G	H
2	Development, Test	Production		Test, Production	Test, Production	#N/A	Production	#N/A	Development,Test,Production
3	dog		cat, horse, donkey	cat	cat		horse,cat		dog,cat,horse,donkey
Sheet1

Hi Peter,

Though it took time as i have around 4k rows of data in my sheet it worked perfectly ang gave the right output. thank you so much for that.

Sorry but can you help to amend the code as I have this data in my original sheet starting from BP. (data from A2:BO2 should be ignored) and ends in DL.

 

[Peter_SSs]

Try making this change. Results will then come in column DM.

  With ActiveSheet.UsedRange
  With Intersect(ActiveSheet.UsedRange.EntireRow, Columns("BP:DL"))

 

[Balajibenz]

Try making this change. Results will then come in column DM.

  With ActiveSheet.UsedRange
  With Intersect(ActiveSheet.UsedRange.EntireRow, Columns("BP:DL"))

Thanks Peter

 

[Peter_SSs]

Thanks Peter

You're welcome.