VBA - Copy row, adjust cell content and

[haddy]

Hi,

Apologies if this type of solution has been posted elsewhere - I have been attempting to use a variation of the solution provided under https://www.mrexcel.com/forum/excel...-paste-row-while-replacing-2-cell-values.html

What I'm trying to achieve is having excel look through a column to locate ", " and split up the text within the cell located into a number of rows. As shown in the tables below; ID 3 would be copied over three times and ID 4 twice. I found difficulty with identifying the 'original' row with its cell contents (minus what had already been copied over).

New to the VBA scene, so I'm hoping someone could assist.


Current data
[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Content[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]RD-001[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]RD-002[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]RD-003, RD-004, RD-005[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]RD-006, RD-007[/TD]
[/TR]
</tbody>[/TABLE]

Data I'd like to have after running the macro
[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Content[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]RD-001[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]RD-002[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]RD-003[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]RD-004[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]RD-005[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]RD-006[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]RD-007[/TD]
[/TR]
</tbody>[/TABLE]


Edit; Title was meant to read 'VBA - Copy row, adjust cell content and remove redundant cell content'

 

[Akuini]

Try this.
If you have a large data and the result is more than 100K rows then you need to adjust this part of the code:
ReDim vb(1 To 100000, 1 To 2)

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1089775a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1089775-vba-copy-row-adjust-cell-content.html[/COLOR][/I]

[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, vb

va = Range([COLOR=brown]"A2:B"[/COLOR] & Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp).Row)
[COLOR=Royalblue]ReDim[/COLOR] vb([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]100000[/COLOR], [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR])

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])

    [COLOR=Royalblue]If[/COLOR] InStr(va(i, [COLOR=crimson]2[/COLOR]), [COLOR=brown]", "[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
        [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x [COLOR=Royalblue]In[/COLOR] Split(va(i, [COLOR=crimson]2[/COLOR]), [COLOR=brown]", "[/COLOR])
        j = j + [COLOR=crimson]1[/COLOR]
        vb(j, [COLOR=crimson]1[/COLOR]) = va(i, [COLOR=crimson]1[/COLOR]): vb(j, [COLOR=crimson]2[/COLOR]) = x
        [COLOR=Royalblue]Next[/COLOR]
    [COLOR=Royalblue]Else[/COLOR]
        j = j + [COLOR=crimson]1[/COLOR]
        vb(j, [COLOR=crimson]1[/COLOR]) = va(i, [COLOR=crimson]1[/COLOR]): vb(j, [COLOR=crimson]2[/COLOR]) = va(i, [COLOR=crimson]2[/COLOR])
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

[COLOR=Royalblue]Next[/COLOR]

Range([COLOR=brown]"A2"[/COLOR]).Resize(j, [COLOR=crimson]2[/COLOR]) = vb

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[haddy]

Thank you Akuini for your timely solution,

Working through trying to understand what you've done but it works with the smaller example. I've adjusted the code you've put together to suit data I'm looking at - please correct me if I'm wrong.

My column range is between A & W, and my cells I'd like to split is under Column D.
What am I missing?

Sub a1089775a()'https://www.mrexcel.com/forum/excel-questions/1089775-vba-copy-row-adjust-cell-content.html


Dim i As Long, j As Long, k As Long
Dim va, vb


va = Range("A2:W" & Cells(Rows.Count, "D").End(xlUp).Row)
ReDim vb(1 To 100000, 1 To 2)


For i = 1 To UBound(va, 1)


    If InStr(va(i, 2), ", ") Then
        For Each x In Split(va(i, 2), ", ")
        j = j + 1
        vb(j, 1) = va(i, 1): vb(j, 2) = x
        Next
    Else
        j = j + 1
        vb(j, 1) = va(i, 1): vb(j, 2) = va(i, 2)
    End If


Next


Range("A2").Resize(j, 2) = vb


End Sub

 

[Akuini]

Ok. try this one:

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1089775b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1089775-vba-copy-row-adjust-cell-content.html[/COLOR][/I]

[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, vb

va = Range([COLOR=brown]"A2:W"[/COLOR] & Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp).Row)
[COLOR=Royalblue]ReDim[/COLOR] vb([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]100000[/COLOR], [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]2[/COLOR]))

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])

    [COLOR=Royalblue]If[/COLOR] InStr(va(i, [COLOR=crimson]4[/COLOR]), [COLOR=brown]", "[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
        [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x [COLOR=Royalblue]In[/COLOR] Split(va(i, [COLOR=crimson]4[/COLOR]), [COLOR=brown]", "[/COLOR])
        j = j + [COLOR=crimson]1[/COLOR]
            [COLOR=Royalblue]For[/COLOR] n = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]23[/COLOR]
            vb(j, n) = va(i, n)
            [COLOR=Royalblue]Next[/COLOR]
        vb(j, [COLOR=crimson]4[/COLOR]) = x
        [COLOR=Royalblue]Next[/COLOR]
    [COLOR=Royalblue]Else[/COLOR]
        j = j + [COLOR=crimson]1[/COLOR]
            [COLOR=Royalblue]For[/COLOR] n = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]23[/COLOR]
            vb(j, n) = va(i, n)
            [COLOR=Royalblue]Next[/COLOR]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

[COLOR=Royalblue]Next[/COLOR]

Range([COLOR=brown]"A2"[/COLOR]).Resize(j, UBound(vb, [COLOR=crimson]2[/COLOR])) = vb

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR]
[/FONT]

 

[haddy]

Thanks again Akuini