Forum Discussion

alexli1219's avatar
alexli1219
Copper Contributor
Aug 20, 2019

Separate words in a single cell into multiple individual cells?

I have a few hundred cells with data in each cell that I am trying to separate into individual cells.

The data/words in the cell are formated like Something=Yes;something else=no. I am trying to take the "something" and put it in cell A1. The "yes" into cell B1, and so on and so forth. 

 

There are a few hundred of these and I am trying to find a way to separate it in a quicker manner rather than typing it all out.

excel
Formulas and Functions

1 Reply

  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Silver Contributor
    Aug 20, 2019

    alexli1219 

     

    You may try the following code to split the data in the desired format.

     

     

     

    Sub SplitData()
Dim wsData As Worksheet, wsOutput As Worksheet
Dim lr As Long, lc As Long, i As Long, ii As Long, j As Long
Dim x, y()
Dim str() As String

Application.ScreenUpdating = False

Set wsData = Worksheets("Sheet1")   'Sheet with raw data in Column A
lr = wsData.Cells(Rows.Count, 1).End(xlUp).Row

On Error Resume Next
Set wsOutput = Worksheets("Output") 'Outupt Sheet
wsOutput.Cells.Clear
On Error GoTo 0

If wsOutput Is Nothing Then
    Set wsOutput = Worksheets.Add(after:=wsData)
    wsOutput.Name = "Output"
End If

x = wsData.Range("A1:A" & lr).Value
ReDim y(1 To lr, 1 To 1)
For i = 1 To UBound(x, 1)
    str = Split(x(i, 1), ";")
    j = 1
    If UBound(y, 2) < (UBound(str) + 1) * 2 Then ReDim Preserve y(1 To lr, 1 To (UBound(str) + 1) * 2)
    For ii = LBound(str) To UBound(str)
        y(i, j) = Split(str(ii), "=")(0)
        y(i, j + 1) = Split(str(ii), "=")(1)
        j = j + 2
    Next ii
Next i

wsOutput.Range("A2").Resize(lr, UBound(y, 2)).Value = y
lc = wsOutput.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

For i = 1 To lc Step 2
    wsOutput.Cells(1, i) = "Name"
    wsOutput.Cells(1, i + 1) = "Trait"
Next i

wsOutput.UsedRange.Columns.AutoFit
wsOutput.Select

Application.ScreenUpdating = True
End Sub

     

     

    Please click the button called "Split Data" on Sheet1 to run the code.

     

     

     

     

Resources