CODEWITHSUNDEEP
excelvba
Hesham
Hesham

Reputation: 3

VBA Code to split data in Range of Cells

I have edited this question to add the code i already have.

I need a VBA Excel code to split data in Cells.

Split Rule : 1- Whenever you find a space " " split and put it into the next column , then 2- Loop to the next row and do the same until Cell is blank i.e no more data.

Please refer to the attached Image for example - Data to split in Column A and the result will be in the next columns.

I tried the code below and it do the job but it doesn't loop to the next row , May you please edit this code to make it loop to next row and stop when there is no more data i.e. Blank Cell. 

Sub example()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, " ")
For a = 0 To UBound(name)
Cells(1, a + 1).Value = name(a)
Next a
End Sub

Thanks so much.

example

Upvotes: 0

Views: 9866

Answers (3)

Victor Moraes
Victor Moraes

Reputation: 972

Here is how I would approach this, although @Darren Bartrup-Cook's solution seems more straightforward

Dim ws As Worksheet
Dim lastRow As Long
Dim data As Range, dataList As Range
Dim arrData, i

Set ws = ThisWorkbook.Worksheets("YourWorksheetName")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set dataList = ws.Range("A1").Resize(lastRow, 1)

For Each data In dataList
    arrData = Split(data.Value)
    For i = LBound(arrData) To UBound(arrData)
        ws.Cells(data.Row, i + 2).Value = arrData(i)
    Next
Next

Update: Another possibility is to use my approach in order to dynamically get the Used Range (with a couple modifications) and then replace my For loop with Darren's approach to perform the Split. You would end up with something like the following

Sub Test()

    Dim lastRow As Long
    Dim dataList As Range

    With ThisWorkbook.Worksheets("YourWorksheetName")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set dataList = .Range("A1").Resize(lastRow, 1)
    End With

    SplitText dataList

End Sub

Sub SplitText(MyRange As Range)

    MyRange.TextToColumns Destination:=MyRange.Offset(, 1), DataType:=xlDelimited, _
        TextQualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=True, _
        Space:=True

End Sub

Update 2: This version will run the code for each worksheet in the workbook 

Sub Test()

    Dim lastRow As Long
    Dim ws as Worksheet
    Dim dataList As Range

    For Each ws In ThisWorkbook.Worksheets
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        Set dataList = ws.Range("A1").Resize(lastRow, 1)
        SplitText dataList
    Next

End Sub

Sub SplitText(MyRange As Range)

    MyRange.TextToColumns Destination:=MyRange.Offset(, 1), DataType:=xlDelimited, _
        TextQualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=True, _
        Space:=True

End Sub

Upvotes: 0

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19782

The macro record shows this when using TextToColumns: 

Selection.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Replacing Selection with your chosen range, and removing some of the parameters which have a default value of false you can use this code to split the values in the range A2:A4. 

Sub Test()

    SplitText ThisWorkbook.Worksheets("Sheet1").Range("A2:A4")

End Sub

Sub SplitText(MyRange As Range)

    MyRange.TextToColumns Destination:=MyRange.Offset(, 1), DataType:=xlDelimited, _
        TextQualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=True, _
        Space:=True

End Sub

Upvotes: 1

RhyminSimon
RhyminSimon

Reputation: 51

I have just made a quick and dirty example. It only matches your example and has to be expanded to match several cases. 

Public Sub spliting()

Dim row As Integer
Set ws = Sheets("sheet1")
row = 1
Dim TestArray As Variant
With ws
    Do
        TestArray = split(CStr(.Cells(row, 1).Value))
        .Cells(row, 2) = TestArray(0)
        .Cells(row, 3) = TestArray(1)
        .Cells(row, 4) = TestArray(2)
        row = row + 1
    Loop Until row = 4
End With

End Sub

Upvotes: 0

Related Questions