Home

Separate words in a single cell into multiple individual cells?

%3CLINGO-SUB%20id%3D%22lingo-sub-814061%22%20slang%3D%22en-US%22%3ESeparate%20words%20in%20a%20single%20cell%20into%20multiple%20individual%20cells%3F%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-814061%22%20slang%3D%22en-US%22%3E%3CP%3EI%20have%20a%20few%20hundred%20cells%20with%20data%20in%20each%20cell%20that%20I%20am%20trying%20to%20separate%20into%20individual%20cells.%3C%2FP%3E%3CP%3EThe%20data%2Fwords%20in%20the%20cell%20are%20formated%20like%20Something%3DYes%3Bsomething%20else%3Dno.%20I%20am%20trying%20to%20take%20the%20%22something%22%20and%20put%20it%20in%20cell%20A1.%20The%20%22yes%22%20into%20cell%20B1%2C%20and%20so%20on%20and%20so%20forth.%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThere%20are%20a%20few%20hundred%20of%20these%20and%20I%20am%20trying%20to%20find%20a%20way%20to%20separate%20it%20in%20a%20quicker%20manner%20rather%20than%20typing%20it%20all%20out.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-814061%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EFormulas%20and%20Functions%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-814107%22%20slang%3D%22en-US%22%3ERe%3A%20Separate%20words%20in%20a%20single%20cell%20into%20multiple%20individual%20cells%3F%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-814107%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F395575%22%20target%3D%22_blank%22%3E%40alexli1219%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EYou%20may%20try%20the%20following%20code%20to%20split%20the%20data%20in%20the%20desired%20format.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-markup%22%3E%3CCODE%3ESub%20SplitData()%0ADim%20wsData%20As%20Worksheet%2C%20wsOutput%20As%20Worksheet%0ADim%20lr%20As%20Long%2C%20lc%20As%20Long%2C%20i%20As%20Long%2C%20ii%20As%20Long%2C%20j%20As%20Long%0ADim%20x%2C%20y()%0ADim%20str()%20As%20String%0A%0AApplication.ScreenUpdating%20%3D%20False%0A%0ASet%20wsData%20%3D%20Worksheets(%22Sheet1%22)%20%20%20'Sheet%20with%20raw%20data%20in%20Column%20A%0Alr%20%3D%20wsData.Cells(Rows.Count%2C%201).End(xlUp).Row%0A%0AOn%20Error%20Resume%20Next%0ASet%20wsOutput%20%3D%20Worksheets(%22Output%22)%20'Outupt%20Sheet%0AwsOutput.Cells.Clear%0AOn%20Error%20GoTo%200%0A%0AIf%20wsOutput%20Is%20Nothing%20Then%0A%20%20%20%20Set%20wsOutput%20%3D%20Worksheets.Add(after%3A%3DwsData)%0A%20%20%20%20wsOutput.Name%20%3D%20%22Output%22%0AEnd%20If%0A%0Ax%20%3D%20wsData.Range(%22A1%3AA%22%20%26amp%3B%20lr).Value%0AReDim%20y(1%20To%20lr%2C%201%20To%201)%0AFor%20i%20%3D%201%20To%20UBound(x%2C%201)%0A%20%20%20%20str%20%3D%20Split(x(i%2C%201)%2C%20%22%3B%22)%0A%20%20%20%20j%20%3D%201%0A%20%20%20%20If%20UBound(y%2C%202)%20%26lt%3B%20(UBound(str)%20%2B%201)%20*%202%20Then%20ReDim%20Preserve%20y(1%20To%20lr%2C%201%20To%20(UBound(str)%20%2B%201)%20*%202)%0A%20%20%20%20For%20ii%20%3D%20LBound(str)%20To%20UBound(str)%0A%20%20%20%20%20%20%20%20y(i%2C%20j)%20%3D%20Split(str(ii)%2C%20%22%3D%22)(0)%0A%20%20%20%20%20%20%20%20y(i%2C%20j%20%2B%201)%20%3D%20Split(str(ii)%2C%20%22%3D%22)(1)%0A%20%20%20%20%20%20%20%20j%20%3D%20j%20%2B%202%0A%20%20%20%20Next%20ii%0ANext%20i%0A%0AwsOutput.Range(%22A2%22).Resize(lr%2C%20UBound(y%2C%202)).Value%20%3D%20y%0Alc%20%3D%20wsOutput.Cells.Find(%22*%22%2C%20SearchOrder%3A%3DxlByColumns%2C%20SearchDirection%3A%3DxlPrevious).Column%0A%0AFor%20i%20%3D%201%20To%20lc%20Step%202%0A%20%20%20%20wsOutput.Cells(1%2C%20i)%20%3D%20%22Name%22%0A%20%20%20%20wsOutput.Cells(1%2C%20i%20%2B%201)%20%3D%20%22Trait%22%0ANext%20i%0A%0AwsOutput.UsedRange.Columns.AutoFit%0AwsOutput.Select%0A%0AApplication.ScreenUpdating%20%3D%20True%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EPlease%20click%20the%20button%20called%20%22Split%20Data%22%20on%20Sheet1%20to%20run%20the%20code.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E
alexli1219
Occasional Visitor

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.

1 Reply

@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.

 

 

 

 

Related Conversations
Tabs and Dark Mode
cjc2112 in Discussions on
22 Replies
Stable version of Edge insider browser
HotCakeX in Discussions on
35 Replies
flashing a white screen while open new tab
cntvertex in Discussions on
13 Replies
How to Prevent Teams from Auto-Launch
chenrylee in Microsoft Teams on
28 Replies