Help me code VBA split string!!!

[Nguyen Anh Dung]

i have column A,B, C as below

I want split column B,C with character "|" result as picture below

Thanks and Best regards!!!

 

[Nguyen Anh Dung]

Input data

Book1.xlsm
	A	B	C
1	100	aaa | ddd1	26565|9877
2	101	aaa | ddd2	26565|9878
3	102	aaa | ddd3	26565|9879
4
Sheet1

Output data

Book1.xlsm
	A	B	C
1	100	aaa	26565
2	100	ddd1	9877
3	101	aaa	26565
4	101	ddd2	9878
5	102	aaa	26565
6	102	ddd3	9879
7
Sheet2

VBA code.

Sub Splitdata()
Dim A, X, Y
Dim Dic As Object
Dim Lr&, T&, Ta&, Z&
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
Lr = .Range("A" & Rows.Count).End(xlUp).Row
A = .Range("A1:C" & Lr)
End With
For T = 1 To UBound(A, 1)
X = Split(A(T, 2), "|")
Y = Split(A(T, 3), "|")
    For Ta = 0 To UBound(X, 1)
    Z = Z + 1
    Dic.Item(Z) = Array(A(T, 1), Trim(X(Ta)), Trim(Y(Ta)))
    Next Ta
X = "": Y = ""
Next T

With Sheets("Sheet2").Range("A1")
.CurrentRegion.Clear
.Resize(Z, 3) = Application.Index(Dic.items, 0, 0)
End With

End Sub

i run have error as below picture

Thanks you!!!

 

[kvsrinivasamurthy]

Try.

Sub Splitdata()
Dim A, X, Y
Dim Dic As Object
Dim Lr&, T&, Ta&, Z&
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
Lr = .Range("A" & Rows.Count).End(xlUp).Row
A = .Range("A1:C" & Lr)
End With
For T = 1 To UBound(A, 1)
If A(T, 2) <> "" And A(T, 3) <> "" Then
X = Split(A(T, 2), "|")
Y = Split(A(T, 3), "|")

    For Ta = 0 To WorksheetFunction.Min(UBound(X, 1), UBound(Y, 1))
    Z = Z + 1
    If X(Ta) <> "" And Y(Ta) <> "" Then
    Dic.Item(Z) = Array(A(T, 1), Trim(X(Ta)), Trim(Y(Ta)))
    End If
    Next Ta
X = "": Y = ""
End If
Next T

With Sheets("Sheet2").Range("A1")
.CurrentRegion.Clear
.Resize(Z, 3) = Application.Index(Dic.items, 0, 0)
End With

End Sub

 

[Sam_D_Ben]

May be another approach,

Sub test()
    Dim X%, Y%, Z%, xA$, xB, xC
    Dim xD As Worksheet
    Dim xR&

    Set xD = ActiveSheet
    xR = 1
    Z = xD.Cells(xD.Rows.Count, "A").End(xlUp).Row

    For X = 1 To Z
        xA = xD.Cells(X, "A").Value
        xB = Split(xD.Cells(X, "B").Value, "|")
        xC = Split(xD.Cells(X, "C").Value, "|")

        For Y = 0 To Application.WorksheetFunction.Max(UBound(xB), UBound(xC))
            xD.Cells(xR, "E").Value = xA
            If Y <= UBound(xB) Then xD.Cells(xR, "F").Value = Trim(xB(Y))
            If Y <= UBound(xC) Then xD.Cells(xR, "G").Value = Trim(xC(Y))
            xR = xR + 1
        Next Y
    Next X
End Sub

 

[Nguyen Anh Dung]

Sub test() Dim X%, Y%, Z%, xA$, xB, xC Dim xD As Worksheet Dim xR& Set xD = ActiveSheet xR = 1 Z = xD.Cells(xD.Rows.Count, "A").End(xlUp).Row For X = 1 To Z xA = xD.Cells(X, "A").Value xB = Split(xD.Cells(X, "B").Value, "|") xC = Split(xD.Cells(X, "C").Value, "|") For Y = 0 To Application.WorksheetFunction.Max(UBound(xB), UBound(xC)) xD.Cells(xR, "E").Value = xA If Y <= UBound(xB) Then xD.Cells(xR, "F").Value = Trim(xB(Y)) If Y <= UBound(xC) Then xD.Cells(xR, "G").Value = Trim(xC(Y)) xR = xR + 1 Next Y Next X End Sub

Thanks you so much!!!

 

[Nguyen Anh Dung]

Try.

Sub Splitdata()
Dim A, X, Y
Dim Dic As Object
Dim Lr&, T&, Ta&, Z&
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
Lr = .Range("A" & Rows.Count).End(xlUp).Row
A = .Range("A1:C" & Lr)
End With
For T = 1 To UBound(A, 1)
If A(T, 2) <> "" And A(T, 3) <> "" Then
X = Split(A(T, 2), "|")
Y = Split(A(T, 3), "|")

    For Ta = 0 To WorksheetFunction.Min(UBound(X, 1), UBound(Y, 1))
    Z = Z + 1
    If X(Ta) <> "" And Y(Ta) <> "" Then
    Dic.Item(Z) = Array(A(T, 1), Trim(X(Ta)), Trim(Y(Ta)))
    End If
    Next Ta
X = "": Y = ""
End If
Next T

With Sheets("Sheet2").Range("A1")
.CurrentRegion.Clear
.Resize(Z, 3) = Application.Index(Dic.items, 0, 0)
End With

End Sub

Great, thanks you so much!!!