VBA script to insert new rows based on data in other cells... then cut data from those cells and paste into those new rows

[mbnnyc]

Hi, I have a spreadsheet that contains mailing list data. It's in a format in which there are Alt1Email (column R), Alt2Email (column S), Alt3Email (column T), and Alt4Email (column U). Wanna cut and paste that data from those columns to the Email column (column Q) in NEW ROWs based on how many AltEmails the contact has. Then ultimately delete columns R,S,T, and U. I thought this out in a plain logic script (below) but being new to VBA I'm having trouble understand syntax a bit. Please if anyone can assist would greatly appreciate. Kind regards! Attached is the spreadsheet and screenshots.. Thanks!

----------

{If cells in columns R,S,T,U are all Populated (not null) in the row the VBA script is working on... first row being row TWO... so R2,S2,T2,U2)

then

INSERT FOUR new rows BELOW this row

AND

COPY from that "reference" row the cell values from columns A thru P... to the corresponding columns of the 4 new rows just created,

AND

CUT cell value from column R AND PASTE IT to the FIRST new row immediately under the original "reference" row into COLUMN Q

AND

CUT column S value and paste to SECOND new row's Q column

AND

CUT column T value and paste to THIRD new row's Q column

AND

CUT column U value and paste to FOURTH new row's Q column}

OR

{If out of R,S,T,U.... only columns R,S, & T (only 3 alt-emails) are populated in the current "reference" row

then

INSERT THREE new rows below this row

AND

COPY from that "reference" row the cell values from columns A thru P... and paste into to the corresponding columns of the THREE new rows just created,

AND

CUT cell value from column R AND PASTE IT to the FIRST new row immediedly under the original "reference" row

INTO COLUMN Q

AND

CUT column S value and paste to SECOND new row's Q column

AND

CUT column T value and paste to THIRD new row's Q column}

OR

{If out of R,S,T,U, only R & S (only 2 alt-emails) are populated in that "reference" row

then

INSERT TWO new rows below the reference row

AND

copy from that "reference" row the cell values from columns A thru P... and PASTE to the corresponding columns of the THREE new rows just created,

AND

CUT cell value from column R AND PASTE IT to the FIRST new row immediedly under the original "reference" row to COLUMN Q

AND

CUT column S value and Paste to SECOND new row's Q column}

OR

{If out of R,S,T, U, only column R is populated in that particular row)

then

INSERT ONE new row below the reference row

AND COPY from that "reference" row the cell values from columns A thru P... and paste into to the corresponding columns of the THREE new rows just created,




AND

CUT cell value from column R AND PASTE IT to the FIRST new row immediedly under the original "reference" row into COLUMN Q}

{If we just added 4 new rows, move down FIVE rows from the original row... if this new “reference” row is a totally blank row, END this script,

If not, make THIS row the new “reference” row AND go back to beginning of script

if we just added 3 new rows, move down FOUR rows from the original row... if this is a totally blank row, END this script

If not, make THIS row the new “reference” row AND go back to beginning of script

{if we just added 2 new rows, move down THREE rows from the original row... if this is a totally blank row, END this script,

If not, make THIS row the new “reference” row AND go back to beginning of script}

{if we just added 1 new row, move down 2 rows from the original row... if this is a totally black row, END this script, if not, make THIS row the new criteria row}

{if we added no new rows in the above process, move down to the next row below original row. if this is a totally BLANK NULL row, END this script,}

Go back to beginning criteria of this script

-------

Example:

Sheet example BEFORE running VBA script:

Add-Specific-Number-of-Rows-And-Populate-Based-On-Cell-Value.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1	Category A	Category B	Category C	Category D	Category E	Category F	Category G	Category H	Category I	Category J	FirstName	LastName	Personal	Close Personal	What	Company	Email	AltEmail1	AltEmail2	AltEmail3	AltEmail4
2	x	x	x	x			x		x		Albert	Hammond	x	x	Guitarist	Roland	ahammond@gmail.com	fenderbender@gmail.com
3	x		x		x				x		Cynthia	Jones			Painter	Warhol Inc.	info@warhol.com	cynthia@warhol.inc	cjones@gmail.com
4									x		Derrick	Lewis			Carpenter	All Done Right Inc.	derrick_lewis@alldoneright.org
5					x						Edward	Alby	x		Lighting Designer	Brighter Days	albyed@brigherdays.com	e.alby@gmail.com	e.alby@mac.com
6		x			x		x			x	Jeff	Cousins	x	x	Dancer	Breakin Up Inc.	jeffcousins@gmail.com
7					x			x			Marcus	Kaufman	x		Singer	Lauren Nicole	marcusk@ln.com
8	x										Lauren	Betts			Drummer	First Instruments	laurenbetts@hotmail.com
9		x	x				x		x		Pauline	Huerta	x		Acrobat	Mission Inc.	aria101@aol.com
10	x	x	x	x	x	x				x	Richard	Grove	x		Broadcaster	ABC	c.martini@missoni.it	richard.grove@abc.com	rgrove@gmail.com	grove131@hotmail.com	rgrove@grove.com
Before

Sheet example AFTER running VBA script:

Add-Specific-Number-of-Rows-And-Populate-Based-On-Cell-Value.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1	Category A	Category B	Category C	Category D	Category E	Category F	Category G	Category H	Category I	Category J	FirstName	LastName	Personal	Close Personal	What	Company	Email	AltEmail1	AltEmail2	AltEmail3	AltEmail4
2	x	x	x	x			x		x		Albert	Hammond	x	x	Guitarist	Roland	ahammond@gmail.com
3	x	x	x	x			x		x		Albert	Hammond	x	x	Guitarist	Roland	fenderbender@gmail.com
4	x		x		x				x		Cynthia	Jones			Painter	Warhol Inc.	info@warhol.com
5	x		x		x				x		Cynthia	Jones			Painter	Warhol Inc.	cynthia@warhol.inc
6	x		x		x				x		Cynthia	Jones			Painter	Warhol Inc.	cjones@gmail.com
7									x		Derrick	Lewis			Carpenter	All Done Right Inc.	derrick_lewis@alldoneright.org
8					x						Edward	Alby	x		Lighting Designer	Brighter Days	albyed@brigherdays.com
9					x						Edward	Alby	x		Lighting Designer	Brighter Days	e.alby@gmail.com
10					x						Edward	Alby	x		Lighting Designer	Brighter Days	e.alby@mac.com
11		x			x		x			x	Jeff	Cousins	x	x	Dancer	Breakin Up Inc.	jeffcousins@gmail.com
12					x			x			Marcus	Kaufman	x		Singer	Lauren Nicole	marcusk@ln.com
13	x										Lauren	Betts			Drummer	First Instruments	laurenbetts@hotmail.com
14		x	x				x		x		Pauline	Huerta	x		Acrobat	Mission Inc.	aria101@aol.com
15	x	x	x	x	x	x				x	Richard	Grove	x		Broadcaster	ABC	c.martini@missoni.it
16	x	x	x	x	x	x				x	Richard	Grove	x		Broadcaster	ABC	richard.grove@abc.com
17	x	x	x	x	x	x				x	Richard	Grove	x		Broadcaster	ABC	rgrove@gmail.com
18	x	x	x	x	x	x				x	Richard	Grove	x		Broadcaster	ABC	grove131@hotmail.com
19	x	x	x	x	x	x				x	Richard	Grove	x		Broadcaster	ABC	rgrove@grove.com
After

 

[mbnnyc]

Forgot to mention... using MS Excel 2013 for Windows and VBA 7.1 that comes with it.

 

[aRandomHelper]

Welcome to the forum!

Try running this on a copy of the 'Before' sheet:

Sub ME1165153_Split()
    Dim i As Long, j As Long, k As Long, c As Long
    Dim a, b()
    
    With ActiveSheet
        With .UsedRange.Offset(1)
            With .Resize(.Rows.Count - 1)
                a = .Value
                c = Application.CountA(.Columns(18).Resize(, 4))
                .Columns(18).Resize(, 4).ClearContents
            End With
        End With
        
        ReDim b(1 To UBound(a, 1) + c, 1 To 17)
        c = 1
        For i = 1 To UBound(a, 1)
            For j = 1 To 17
                b(c, j) = a(i, j)
            Next
            For j = 18 To UBound(a, 2)
                If a(i, j) <> "" Then
                    c = c + 1
                    For k = 1 To 16
                        b(c, k) = a(i, k)
                    Next
                    b(c, 17) = a(i, j)
                End If
            Next
            c = c + 1
        Next
        
        .Range("a2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
        .Columns.AutoFit
    End With
End Sub

 

[Fluff]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: multiple locations
Please provide links to all sites where you have asked this question

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[mbnnyc]

Thanks aRandomHelper for the quick effort to put this together for me. Much apprecated. Will try when I get home (and report back). Also, I got a solution that definitely works from Jolivanes (on ExcelForum) --------> VBA script to insert new rows based on data in other cells, then cut/paste into new row Thanks!!!
?

 

[Fluff]

@mbnnyc Please post links to all sites where you have asked this question. Thanks

 

[mbnnyc]

@mbnnyc Please post links to all sites where you have asked this question. Thanks

VBA script to insert new rows based on data in other cells... then cut data from those cells and paste into those new rows - OzGrid Free Excel/VBA Help Forum

[xpost][/xpost] Hi, I have a spreadsheet that contains mailing list data. It's in a format in which there are Alt1Email (column R), Alt2Email (column S), Alt3Email (column T), and Alt4Email (column U). Wanna cut and paste that data from those columns…

www.ozgrid.com

VBA script to insert new rows based on data in other cells, then rearrange data

Hi, I have a spreadsheet that contains mailing list data. It's in a format in which there are Alt1Email (column R), Alt2Email (column S), Alt3Email (column T), and Alt4Email (column U). Wanna cut and paste that data from those columns to the Email column (column Q) in NEW ROWs based on how...

www.vbaexpress.com

https://www.myonlinetraininghub.com/excel-forum/vba-macros/vba-script-to-insert-new-rows-based-on-data-in-other-cells-then-cut-data-from-those-cells-and-paste-into-those-new-rows#p19608

VBA script to insert new rows based on data in other cells... then cut data from those cells and paste into those new rows

Hi, I have a spreadsheet that contains mailing list data. It's in a format in which there are Alt1Email (column R), Alt2Email (column S), Alt3Email (column T), and Alt4Email (column U). Wanna cut and paste that data from those columns to the Email column (column Q) in NEW ROWs based on how...

chandoo.org

VBA script to insert new rows based on data in other cells... then cut data from thos-VBForums

Hi, I have a spreadsheet that contains mailing list data. It's in a format in which there are Alt1Email (column R), Alt2Email (column S), Alt3Email (column T), and Alt4Email (column U). Wanna cut and paste that data from those columns to the Email column (column Q) in NEW ROWs based on how...

www.vbforums.com