VBA Convert column of comma separated cell data into single column

[Cwillson]

Hey folk,

Column A in my worksheet consists of cells which contain comma separated numeric strings. I need to convert all these individual numeric strings into a single column of unique values.

For example;

A (source data)	B (result)
4567, 8456, 46	12
12, 46, 7865	46
	4567
	7865
	8456

Thanks!

 

[Zot]

This is what you need I believe

How to split comma separated values into rows or columns in Excel?

ExtendOffice provides a comprehensive range of professional software solutions, enhancing productivity and efficiency for businesses worldwide.

www.extendoffice.com

 

[Rick Rothstein]

Here is a macro that you can try...

Sub Cwillson()
  Dim X As Long, Arr As Variant
  Arr = Split(Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))), ", "), ", ")
  With CreateObject("Scripting.Dictionary")
    For X = 0 To UBound(Arr)
      .Item(Arr(X)) = 1
    Next
    Arr = .Keys
  End With
  Application.ScreenUpdating = False
  With Range("B1").Resize(UBound(Arr) + 1)
    .Value = Application.Transpose(Arr)
    .Parent.Sort.SortFields.Clear
    .Parent.Sort.SortFields.Add2 Key:=.Cells, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Parent.Sort.SetRange .Cells
  With .Parent.Sort
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  End With
  Application.ScreenUpdating = True
End Sub

 

[aRandomHelper]

Try running this:

Sub me1170153()
    Dim a, i As Long, v, v2
    With ActiveSheet
        a = .Range("a1", .Cells(.Rows.count, 1).End(xlUp)).Value
        With CreateObject("scripting.dictionary")
            For i = 1 To UBound(a, 1)
                v = Split(Replace(a(i, 1), " ", ""), ",")
                For Each v2 In v
                    .item(v2) = ""
                Next
            Next
            a = .keys
        End With
        .Range("b1").Resize(UBound(a, 1) + 1).Value = Application.Transpose(a)
        .Columns("b").sort .Columns("b")
    End With
End Sub

 

[alansidman]

An alternative means if you are willing is to employ power query.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(Source, {{"A (source data)", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "A (source data)"),
    #"Sorted Rows" = Table.Sort(#"Split Column by Delimiter",{{"A (source data)", Order.Ascending}})
in
    #"Sorted Rows"

 

[Cwillson]

Try running this:

Sub me1170153()
    Dim a, i As Long, v, v2
    With ActiveSheet
        a = .Range("a1", .Cells(.Rows.count, 1).End(xlUp)).Value
        With CreateObject("scripting.dictionary")
            For i = 1 To UBound(a, 1)
                v = Split(Replace(a(i, 1), " ", ""), ",")
                For Each v2 In v
                    .item(v2) = ""
                Next
            Next
            a = .keys
        End With
        .Range("b1").Resize(UBound(a, 1) + 1).Value = Application.Transpose(a)
        .Columns("b").sort .Columns("b")
    End With
End Sub

Amazing, this works an absolute treat! Thank you so much.

 

[Cwillson]

Here is a macro that you can try...

Sub Cwillson()
  Dim X As Long, Arr As Variant
  Arr = Split(Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))), ", "), ", ")
  With CreateObject("Scripting.Dictionary")
    For X = 0 To UBound(Arr)
      .Item(Arr(X)) = 1
    Next
    Arr = .Keys
  End With
  Application.ScreenUpdating = False
  With Range("B1").Resize(UBound(Arr) + 1)
    .Value = Application.Transpose(Arr)
    .Parent.Sort.SortFields.Clear
    .Parent.Sort.SortFields.Add2 Key:=.Cells, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Parent.Sort.SetRange .Cells
  With .Parent.Sort
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  End With
  Application.ScreenUpdating = True
End Sub

Hi Rick,

This didn't work for some reason. Whilst it sorted the resultant column B it didn't split the comma separated values into single cells.

Might have just been how I implemented it, but the other proposed script worked.

Sorry, I'm a VBA newbie (hence not being able to do this in the first place), so cannot debug it.

Chris

 

[Rick Rothstein]

Hi Rick,

This didn't work for some reason. Whilst it sorted the resultant column B it didn't split the comma separated values into single cells.

I am not sure why it did not work for you as I tested it before posting and again just now and it split the values up into individual cells for me. But you have a solution that is working for you so that is all that ultimately matters.