VBA Convert column of comma separated cell data into single column

Cwillson

New Member
Joined
Oct 1, 2015
Messages
36
Office Version
  1. 2019
Platform
  1. Windows
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, 4612
12, 46, 786546
4567
7865
8456

Thanks! :)
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Here is a macro that you can try...
Code:
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
 
Upvote 0
Try running this:

VBA Code:
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
 
Upvote 0
Solution
An alternative means if you are willing is to employ power query.

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"
 
Upvote 0
Try running this:

VBA Code:
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. :)
 
Upvote 0
Here is a macro that you can try...
Code:
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,223,909
Messages
6,175,315
Members
452,634
Latest member
cpostell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top