Copy Paste delete loop if column has data

[hetal247]

Hi,

I am looking for a code that will help with what I want to achieve. I have a table where I have to split a column using text-to-columns. The number of columns created after will vary time to time.

What I now want to do is copy the rows to a certain column and then for each of the columns created after text-to-column, input the data and repeat the process until the last create column has data.

e.g my table looks like this

ID	Name	Items
1	J Bloggs	Table,Chairs,Desk,Stapler
2	R Bear	Chair
3	P Parrot	Desk,Table

<tbody>
</tbody>

So I need to split the items columns which will then show my table as:

ID	Name	Item1	Item2	Item3	Item4
1	J Bloggs	Table	Chairs	Desk	Stapler
2	R Bear	Chair
3	P Parrot	Desk	Table

<tbody>
</tbody>

So I now want to be able to copy the id and names and bring back the items until the last cell so my end table will look like this:

ID	Name	Item
1	J Bloggs	Table
2	R Bear	Chair
3	P Parrot	Desk
1	J Bloggs	Chairs
3	P Parrot	Table
1	J Bloggs	Desk
1	J Bloggs	Stapler

<tbody>
</tbody>

I might be asking a lot for this to happen but wondered if there was a way this could be achieved.

Appreciate any help that is given.

Kind regards
Hetal

 

[MickG]

This code will create the last table from the first table, if that's acceptable.
Results start "E1".

[COLOR="Navy"]Sub[/COLOR] MG25May23
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray()
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] n = 0 To 100
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Offset(, 2), ",")
    [COLOR="Navy"]If[/COLOR] n <= UBound(Sp) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        ReDim Preserve Ray(1 To 3, 1 To c)
        Ray(1, c) = Dn.Value
        Ray(2, c) = Dn.Offset(, 1)
        Ray(3, c) = Sp(n)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] n
Range("E1").Resize(c, 3) = Application.Transpose(Ray)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[hetal247]

Hi Mick,

Thank you for your response. How do i amend the code so it refers to the correct column that needs to be split? My column that needs to be split in this case is column L.

kind regards

Hetal

 

[MickG]

If your column for splitting is "L" then that would imply the first column in your data is "J", so Replace the 3rd line in code as below. shown :-

[COLOR=#000080]Set[/COLOR] Rng = Range("J1"), Range("J" & Rows.Count).End(xlUp))