Microsoft Excel Split Function-CodePudding

anyone can help me with below code ? i currently working on splitting a cells value into two column , the below code can only split 1 row of the data , when i try to split the whole column of a data it doesnt work and indicate error code 13 and type mismatch , i had tried several ways like changing the datatype or the value it simply would not work . I hope anyone can help me with this ....

Option Explicit

Public Sub NameSplit()
Dim Cell As Range
Set Cell = Range("$A$1")

Dim SplitData() As String
SplitData = Split(Expression:=Cell.Value, Delimiter:="  ") 'double space as delimiter

Dim i As Long, j As Long
For i = LBound(SplitData) To UBound(SplitData)
    If Trim$(SplitData(i)) <> vbNullString Then
        Cell.Offset(ColumnOffset:=j).Value = Trim$(SplitData(i))
        j = j   1
    End If
Next i
End Sub

CodePudding user response：

Split Column

This is a basic example, which illustrates how to loop through the cells of a column range, split the contents to an array, and then loop through the elements of the array to write the split substrings to the row.

A Quick Fix

Option Explicit

Sub NameSplit()

    Const FirstCellAddress As String = "A2"
    Const ColumnOffset As Long = 1 ' 0 means A2 (overwrite), 1 means B2,...
    
    Const Delimiter As String = "  "
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim srg As Range
    
    With ws.Range(FirstCellAddress)
        Dim lCell As Range: Set lCell = .Resize(ws.Rows.Count - .Row   1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Sub ' no data in column range
        Set srg = .Resize(lCell.Row - .Row   1)
    End With
    
    Application.ScreenUpdating = False
    
    Dim sCell As Range
    Dim sArr() As String
    Dim n As Long
    
    For Each sCell In srg.Cells
        sArr = Split(CStr(sCell.Value), Delimiter)
        For n = 0 To UBound(sArr)
            sCell.Offset(, ColumnOffset   n).Value = sArr(n)
        Next n
    Next sCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Data split.", vbInformation

End Sub

CodePudding user response：

Try this:

Option Explicit

Sub splitName()

Const Delimiter As String = "  "    'double space

Dim rgToSplit As Range
Set rgToSplit = ActiveSheet.Range("A1").CurrentRegion   '---> adjust this to your needs

Dim arrToSplit As Variant
arrToSplit = rgToSplit.Value

Dim i As Long, arrResult As Variant
For i = 1 To UBound(arrToSplit, 1)
    arrResult = Split(arrToSplit(i, 1), Delimiter)
    If UBound(arrResult) > 0 Then
        rgToSplit(i, 1).Resize(1, UBound(arrResult)   1) = arrResult
    End If
Next

End Sub

The code puts the values of the range to be split into variable arrToSplit.

Then for each value the split is done - writing it to arrResult and arrResult is written back to the row.