split the cell value with sign "|" to make multiple entries to down

**breadwinner** · 06-26-2013, 02:53 AM

Dear Expert

Good Afternoon

Here i am looking for split the values in cell with sign "|" to make multiple entries value to fill down till end of string

RANGE START FROM (A:D) THEN C CELL CONTAINS VALUE
7020511592|7020537873|7005302856|7005298360|7005257369|7020498670|7020495231|7020530082|7020530803|7020491142|7020487175|7020532108 THEN (F:AH) END

RESULT
A:D 7020527336 F:AH
A:D 7020527376 F:AH
A:D 7020525099 F:AH

please find the attachment of file SPLIT VALUE.XLB

**nathansav** · 06-26-2013, 02:59 AM

Heres a good start

Dim strInput As String
Dim arrSplit() As String
Dim a As Variant
Dim iRowCounter As Integer

strInput = "123|456|678"

arrSplit = Split(strInput, "|")

iRowCounter = 1

For Each a In arrSplit

    Worksheets("Sheet1").Range("a1").Offset(iRowCounter - 1, 0).Value = a
    iRowCounter = iRowCounter + 1
    
Next a

**:) Sixthsense :)** · 06-26-2013, 03:14 AM

Try this...

Sub SplitValues()
Dim rMyRng As Range, rResCell As Range, vSplit As Variant, r As Range, i As Integer

Set rMyRng = Application.InputBox("Select The Split Data Range", "Data Range is Required", , , , , , 8)

If rMyRng Is Nothing Then
    MsgBox "Data Range is Required, please try again", vbCritical, "Data Range is Required"
    Exit Sub
End If

Set rResCell = Application.InputBox("Select The Result Cell", "Result Cell Ref is Required", , , , , , 8)

If rResCell Is Nothing Then
    MsgBox "Result Cell Ref is Required, please try again", vbCritical, "Result Cell Ref is Required"
    Exit Sub
End If

Set rResCell = rResCell.Cells(1)

Application.ScreenUpdating = False

For Each r In rMyRng
    vSplit = Split(r.Value, "|")

    For i = LBound(vSplit) To UBound(vSplit)
        rResCell.Value = vSplit(i)
        Set rResCell = rResCell.Offset(1)
    Next i
Next r

Application.ScreenUpdating = True

End Sub

**jindon** · 06-26-2013, 03:34 AM

Try this

Sub test()
    Dim a, b, i As Long, ii As Long, txt As String, n As Long
    With Sheets("input").Cells(1).CurrentRegion
        a = .Value
        txt = Join(.Parent.Evaluate("transpose(" & _
            .Columns(5).Address & ")"), "|")
        ReDim b(1 To Len(txt) - Len(Replace(txt, "|", "")) _
            + UBound(a, 1), 1 To UBound(a, 2))
    End With
    For i = 1 To UBound(a, 1)
        For Each e In Split(a(i, 5), "|")
            n = n + 1
            For ii = 1 To UBound(a, 2)
                b(n, ii) = a(i, ii)
            Next
            b(n, 5) = e
        Next
    Next
    With Sheets("Sheet2").Cells(1).Resize(n, UBound(b, 2))
        .CurrentRegion.ClearContents
        .Value = b
        .Columns.AutoFit
    End With
End Sub