Splitting Data And copying Part 2 (Solved)

[Samnuni]

Previous post: http://www.mrexcel.com/board2/viewtopic.php?t=178752

Hi again, that code worked wonderous, but now I need it to work for more than one input. This is one of the examples of what my sheet looks like with more than 1000 entries:

ZSDE Splitted.xls
	A	B	C	D	E	F	G
1	Customer	Name1	Material	Billing Date	Quantity	Order Reason	Serial Numbers
2	9145	CARRAWAY METHODIST MED CTR	EC-3430L	10/27/2005	2	S26	( E110879, E110880 )
3	9145	CARRAWAY METHODIST MED CTR	EC-3831L	4/3/2005	1	S26	( E01152, E110435, E110444, E11415 )
4	9145	CARRAWAY METHODIST MED CTR	EC-3832L	10/27/2005	9	S26	( E110090, E110091, E110092, E110093, E110094, E110095, E110096, E110097, E110098 )
5	9145	CARRAWAY METHODIST MED CTR	ED-3430T	10/27/2005	2	S26	( A110647, A110648 )
6	9145	CARRAWAY METHODIST MED CTR	EG-2731	4/3/2005	1	S26	( A11565, A11759, E111931, E11951, E11966 )
7	9145	CARRAWAY METHODIST MED CTR	EG-2731	10/27/2005	4	S26	( E131546, E131547, E131548, E131549 )
8	9145	CARRAWAY METHODIST MED CTR	EG-2931	4/3/2005	1	S26	( E01261, E110433, E110442, E110451, E11338, E11363 )
9	9145	CARRAWAY METHODIST MED CTR	EG-2931	10/27/2005	6	S26	( E131470, E131472, E131473, E131474, E131475, E131477 )
10	9145	CARRAWAY METHODIST MED CTR	FC-38LV	10/27/2005	1	S26	( A110686 )
11	9145	CARRAWAY METHODIST MED CTR	FG-29V	10/27/2005	1	S26	( A114597 )
9145

The basic code to split the cells and insert into a new row was given from the post I made on top, but for the life of me I can't insert a for loop to make it do all the entries. And seeing that it just replaces the row that it splits, if it can be copy onto a new worksheet, it'll be wonderful. Thank you in advance.

 

[Samnuni]

Ok, I figured out how to replace the rows and have the info that I wanted to be filled in. However, I don't know how I can fit a loop in there that will check each row from the raw data...

The code I got for inserting rows and filling it with data:

Sub test()
Dim x, i As Long
Dim j, k As Integer

With Range("g2")
    txt = .Value
    x = Split(Replace(Replace(Replace(txt, "(", ""), ")", ""), Chr(32), ""), ",")
    For j = 1 To UBound(x)
    ActiveCell.EntireRow.Insert
    Next j
    .Offset(-UBound(x), -6).Resize(UBound(x) + 1, 6) = .Offset(, -6).Resize(, 6).Value
    .Offset(-UBound(x)).Resize(UBound(x) + 1) = Application.Transpose(x)
End With
End Sub

I know I declared k in there and never used it, I was trying to make a Do Until loop to check the last row so it'll stop when it's empty, but the reference cell g2 never changes and I think that's the problem.

 

[Samnuni]

Ok, the code works only if I modify it and not run this straight up. The mod was made from a piece of code that I was given on here where instead of using "-Ubound(x)" it was 2. Anyone has any idea why it's like that?

Sub test()
Dim x, i As Long
Dim j, k As Integer

    Cells.Replace What:="( ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
    Cells.Replace What:=" )", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows

For k = 2 To 2000
Cells(k, 7).Select
With ActiveCell
    txt = .Value
    x = Split(txt, ",")
    For j = 0 To UBound(x) - 1
    Cells(k + j, 7).EntireRow.Insert
    Next j
    .Offset(-UBound(x), -6).Resize(UBound(x) + 1, 6) = .Offset(, -6).Resize(, 6).Value
    .Offset(-UBound(x)).Resize(UBound(x) + 1) = Application.Transpose(x)
End With
Next k
End Sub

 

[jindon]

Sub test()
Dim x, i As Long
Application.ScreenUpdating = False
With Sheets("9145")
    With .Columns("g")
        .Replace "(", ""
        .Replace ")", ""
    End With
    i = 2
    Do While Not IsEmpty(.Cells(i, "g"))
        If InStr(.Cells(i, "g"), ",") > 0 Then
            x = Split(.Cells(i, "g"), ",")
            .Rows(i + 1 & ":" & i + UBound(x)).Insert
            .Cells(i, "a").Resize(UBound(x) + 1, 6).Value _
                = .Cells(i, "a").Resize(, 6).Value
            .Cells(i, "g").Resize(UBound(x) + 1).Value _
                = Application.Transpose(x)
            i = i + UBound(x)
            Erase x
        End If
        i = i + 1
    Loop
End With
Application.ScreenUpdating = True
End Sub

 

[Samnuni]

Thank you for helping me again. I will give this code a try.

 

[Samnuni]

Works like a charm, thank you so much.