Manipulate text to column function in Excel and separate text with variable number of delimiters

Question

I download data from a vendor and the identifying data, (the first column), has an individual's name and their participant number in the same column separated by commas.

The info is not in general format for Excel, the cells are in text format. I will convert that afterward.

The number of commas in the identifying data column is not the same.

• sometimes a row has only participant number
• sometimes a row has last name, first name, participant number
• sometimes a row has name, participant number.

Participant number will always be last in the identifying column. If an individual wants to be anonymous the name will not be there or partially there.

I am trying to separate it so:

• the participant number is in a column.
• the last name can be with the first name or it can be in its own column.
  It can be done either way.

The names will change and the number of lines will change frequently but probably somewhere about 1000 rows every time I run this macro.

Data starts out like this:

I made this by using record macro in Excel.
I add two columns to the right of the identifying column then do a text to column feature to separate the data by commas. The identifying data is put into three columns and I rename the three columns.

Sub Add_and_rename_columns()

' Add_and_rename_columns Macro

'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
      Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
      :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Participant Last Name"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Participant First Name"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "Participant Number"
    
End Sub

Afterwards I get:

Not all of the participant numbers are in the same column.

Answer 1

If I understand you correctly ....

Data before running the sub is something like this :

After running the sub (expected result) :

Sub test()
Dim rg As Range: Dim cell As Range
Dim cnt As Integer

With ActiveSheet
Set rg = .Range("A4", .Range("A" & Rows.Count).End(xlUp))
End With

rg(1, 2).Resize(1, 2).EntireColumn.Insert

For Each cell In rg
    cnt = Len(cell.Value) - Len(Replace(cell.Value, ",", ""))
    With cell.Resize(1, 3)
        If cnt = 0 Then .Value = Split(",," & cell.Value, ",")
        If cnt = 1 Then .Value = Split(Replace(cell.Value, ",", ",,"), ",")
        If cnt = 2 Then .Value = Split(cell.Value, ",")
    End With
Next

Range("A3").Value = "Participant Last Name"
Range("B3").Value = "Participant First Name"
Range("C3").Value = "Participant Number"

End Sub

rg variable is the range of data in column A starting from row 4 to the last row with data, then it insert two columns and then loop to each cell in rg.

within the loop, it fill each looped cell.resize(1,3) with the array coming from splitting the cell value by comma separated. It check first if there is no comma in the looped cell value, then it add two commas in front of that value then split it. If there is one comma in the looped cell value, then it replace that one comma with two commas, then split it. If there is two commas in the looped cell value, then it just split the looped cell value.

Answer 2

insert two blank columns from your list,edit the column range below, then try

Sub separate_values()
    Dim rng As Range
    Dim cell As Range
    Dim arr() As String
    Dim i As Long, lastRow As Long
    
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range("A1:A" & lastRow) ' Range of cells to check
    
    For Each cell In rng
    If cell.Value <> "" Then
        If InStr(1, cell.Value, ",") = 0 Then
            Cells(cell.Row, 3) = cell.Value
            Cells(cell.Row, 1) = ""
        Else
            arr = split(cell.Value, ",") ' Split cell value by comma and add to array
        
            For i = UBound(arr) To 0 Step -1
                 If UBound(arr) = 2 Then
                 Cells(cell.Row, i + 1) = arr(i)
                 Else
                 Cells(cell.Row, i + 2) = arr(i)
                 Cells(cell.Row, 1) = ""
                 End If
            Next i
           End If
           End If
    Next cell
End Sub