Insert shifts cells down

Panoos64 · Jan 26, 2018

Hi all, I would like to prepare a VBA code so that to insert Shifts Cells Down (not entire row) from “A13”:”AU” and cells down till the last row, if the col. “B” contains number. In F.1. are the original data and in F.2. is the expected result. Please note that the employees are 500+ and so I couldn’t present the whole spreadsheet. Many thanks in advance

F.1.

	A	B	C	D	E	F	G	I	AU
10
11
12		FINGER CODE	EMPL.TYPE	EMPLOYEE NAME	1	2	3	4	5
13		2075		EMPL. 2075	O	X	X	X	X
14		2078		EMPL. 2078	O	X	X	X	X
15		2094		EMPL. 2094	O	X	X	X	0.5

F.2.

	A	B	C	D	E	F	G	I	AU
10
11
12		FINGER CODE	EMPL.TYPE	EMPLOYEE NAME	1	2	3	4	5
13		2075		EMPL. 2075	O	X	X	X	X

14		2078		EMPL. 2078	O	X	X	X	X

15		2094		EMPL. 2094	O	X	X	X	0.5

footoo · Jan 26, 2018

Are there any blank cells in column B between B13 and the last data cell?
Is column A blank (thinking of using it as a temporary helper column)?
Please confirm you want insert from column A through column AU

Panoos64 · Jan 26, 2018

Hi foot,
- No blank cells in column "B" till the last data cell.
- Column "A", i will use it for serial numbers. Apologies that i did not mention it.
- I confirm that the inserted cells should be in range 'A" through column "AU". Please note that the code should run from "A13" and rows down till the last data cells. The first blank partial row should be in row "14". On the above schedule, "F.2." I done a mistake. I did not write the right rows numbers.

Many thank for your support. Have a great day

footoo · Jan 26, 2018

Try this :

Code:

Sub InsrtR()
Dim lr#, rng As Range
[B:B].Insert
lr = Cells(Rows.Count, "C").End(xlUp).Row
Set rng = Range("B13:B" & lr)
[B13] = 1
[B13].AutoFill Destination:=rng, Type:=xlFillSeries
rng.Offset(rng.Cells.Count, 0).Resize(, 47).Insert shift:=xlDown
rng.Copy Cells(lr + 1, 2)
lr = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range([A13], Cells(lr, "AU"))
rng.Sort Key1:=[B13], Order1:=xlAscending, Header:=xlNo
[B:B].Delete
End Sub

Panoos64 · Jan 26, 2018

Hi foot, it works thereafter i modified the code's lines Resize(, 47) to Resize(, 48) and the line Cells(lr, "AU")) to Cells(lr, "Av")). Before the modification the result was like the below schedule. Just advice me that, if is correct the modification which i done or such modifications would be create mess in future?

AR	AS	AT	AU
X	O	X	X
			X
X	O	X	X
			X
0.5	O	X	X
			X
5	1	2	X

X	O	X

X	O	X

0.5	O	X

Panoos64 · Jan 26, 2018

Hi foot, just for records, with the above modification it works perfect. Many thanks once again for your support and your time spent for my project. Have a great, lovely day

Insert shifts cells down

Panoos64

Well-known Member

Excel Facts

footoo

Well-known Member

Panoos64

Well-known Member

footoo

Well-known Member

Panoos64

Well-known Member

Panoos64

Well-known Member

Similar threads

Forum statistics

Share this page

Insert shifts cells down

Panoos64

Well-known Member

Excel Facts

footoo

Well-known Member

Panoos64

Well-known Member

footoo

Well-known Member

Panoos64

Well-known Member

Panoos64

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock