Insert two empty lines only in the "N:T" columns

[harzer]

Hello everyone,
I have a group of columns "N:T" which contains a variable number of rows, I want to add two empty lines after each row in this group of columns starting from cell "N2" and ending at the last row of the of column “T”.
Data outside of the "N:T" columns should not be modified.
I would like to ask you for a solution with arrays (if it is possible) because there are a large number of lines to process.

Sheet before inserting the two empty lines

Permuter2Ranges.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X
1	a	b	c	d	e	f	g	h	i	j	k	l	m	Jeune	Père	Mère		Jeune	Père	Mère
2	a	b	c	d	e	f	g	h	i	j	k	l	m	NM96-010/2021 F	NM96-002/2020 M	NM96-020/2020 F		NM96-008/2021 M	NM96-002/2020 M	NM96-020/2020 F	n	o	p	q
3	a	b	c	d	e	f	g	h	i	j	k	l	m	AE27-026/2022 F	NM96-046/2019 M	NM96-036/2021 F		AE27-018/2022 M	NM96-005/2021 M	AE27-068/2021 F	n	o	p	q
4	a	b	c	d	e	f	g	h	i	j	k	l	m	AE27-037/2022 F	NM96-005/2021 M	AE27-068/2021 F		AE27-019/2022 M	NM96-005/2021 M	AE27-068/2021 F	n	o	p	q
Feuil1

Result after inserting the two empty lines

Permuter2Ranges.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y
1	a	b	c	d	e	f	g	h	i	j	k	l	m	Jeune	Père	Mère		Jeune	Père	Mère
2	a	b	c	d	e	f	g	h	i	j	k	l	m	NM96-010/2021 F	NM96-002/2020 M	NM96-020/2020 F		NM96-008/2021 M	NM96-002/2020 M	NM96-020/2020 F	n	o	p	q	rstwxyz
3	a	b	c	d	e	f	g	h	i	j	k	l	m								n	o	p	q	rstwxyz
4	a	b	c	d	e	f	g	h	i	j	k	l	m								n	o	p	q	rstwxyz
5														AE27-026/2022 F	NM96-046/2019 M	NM96-036/2021 F		AE27-018/2022 M	NM96-005/2021 M	AE27-068/2021 F
6
7
8														AE27-037/2022 F	NM96-005/2021 M	AE27-068/2021 F		AE27-019/2022 M	NM96-005/2021 M	AE27-068/2021 F
9
10
11
Feuil1

Thank you in advance for your contributions.

 

[Joe4]

You are welcome.
Glad we were able to help you to get to a working solution!

 

[Peter_SSs]

because there are a large number of lines to process.

We didn't ever get an indication of what "large number" means to you, but you may want to consider alternatives.

For inserting the extra lines ..

Sub Insert_Rows_v2()
  Dim a As Variant
  Dim i As Long, j As Long, k As Long, rws As Long

  Application.ScreenUpdating = False
  Columns("U").Insert
  rws = Columns("N:T").Find("*", , , , xlByRows, xlPrevious).Row - 1
  ReDim a(1 To 3 * rws, 1 To 1)
  For i = 1 To 3
    For j = 1 To rws
      k = k + 1: a(k, 1) = j
    Next j
  Next i
  Range("U2").Resize(UBound(a)).Value = a
  Range("N2:U2").Resize(UBound(a)).Sort Key1:=Columns("U"), Order1:=xlAscending, Header:=xlNo
  Columns("U").Delete
  Application.ScreenUpdating = True
End Sub

With about 5,000 rows of data, on my (old) machine, the code from post 16 took 20.387 seconds. The above code took the code took 0.059 seconds. That is an improvement of about 350x

To remove those same inserted cells (that is from rows 3,4,6,7,9,10 etc) ..

Sub Delete_Rows()
  Dim lr As Long
   
  Application.ScreenUpdating = False
  Columns("U").Insert
  lr = Columns("N:T").Find("*", , , , xlByRows, xlPrevious).Row
  With Range("N2:U" & lr)
    .Columns(.Columns.Count).Value = Evaluate("if(mod(row(" & .Address & "),3)=2,1,"""")")
    .Sort Key1:=Columns("U"), Order1:=xlAscending, Header:=xlNo
  End With
  Columns("U").Delete
  Application.ScreenUpdating = True
End Sub

For this process, code from post 17 for me took 37.883 seconds and this code took 0.068 seconds, about 550x faster.
Note that my code does not check that the inserted cells are still empty as that requirement was not entirely clear to me. The check could be added to my code if required.

 

[harzer]

Hello Peter_SSs,
Thank you for your feedback and the solutions proposed.
I admit that when it comes to speed, it’s exceptional.
1. Concerning the code for inserting empty lines (on 6000 lines initially): Execution time is 0.23 sec.
2. Regarding the code for removing empty lines:
Before inserting the lines, I had 6000 lines.
After inserting the lines I have 17996 lines) --> Execution time to delete empty lines is 0.21 sec.
Thanks Peter_SSs for this code.

 

[Peter_SSs]

You're welcome. Glad it helped. Thanks for the follow-up.