Adding # of Blank Rows above Non-Blank Rows VBA help

[BraytonM]

Hello all,

I need some help with my VBA. First, my VBA deletes any row where value in Column C is 0. That part works wonderful.

However, it is not properly adding the # of blank lines according to Column C. For instance, it does not add two lines above Row 2 and Row. It seems that the VBA will work for any value in Column C other than 2. I have added the minisheet here as well as the VBA that I am using.

Hopefully, y'all can help!

Sub DeleteAndAdd()
Dim r As Long
Dim lastrow As Long
lastrow = Cells(Rows.Count, "C").End(xlUp).Row
For r = lastrow To 1 Step -1
If Cells(r, "C") = 0 Then
Rows(r).Delete
End If
Next r

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For i = lastrow To 2 Step by - 1

    a = ActiveSheet.Cells(i, 3).Value
        For j = 1 To a
       
            ActiveSheet.Rows(i).Select
            Selection.Insert Shift:=xlDown
           
        Next

Next

ActiveSheet.Cells(1, 1).Select
End Sub

Test.xlsm
	A	B	C
1	Employee No	DELETE ME	DELETE COUNT
2	AAPLES	ST	2
3	AAPLES	RH	3
4	AAPLES	DT	0
5	AAPLES	IW	0
6	BBANANA	ST	2
7	BBANANA	RH	3
8	BBANANA	DT	0
9	BBANANA	IW	0
10	CCHERRY	ST	2
11	CCHERRY	RH	3
12	CCHERRY	DT	0
13	CCHERRY	IW	0
14	DDOG	ST	2
15	DDOG	RH	3
16	DDOG	DT	0
17	DDOG	IW	0
18	EELEPHANT	ST	2
19	EELEPHANT	RH	3
20	EELEPHANT	DT	0
21	EELEPHANT	IW	0
22	FFROG	ST	2
23	FFROG	RH	3
24	FFROG	DT	0
25	FFROG	IW	0
26	GGORILLA	ST	2
27	GGORILLA	RH	3
28	GGORILLA	DT	0
29	GGORILLA	IW	0
MASTER COPY (10)

Cell Formulas
Range	Formula
A2:A29	A2	=RowTimesheet!T40
B2,B6	B2	=IF(A2<>"","ST","")
C2:C29	C2	=SUMPRODUCT((W2:AV2<>"")/COUNTIF(W2:AV2,W2:AV2&""))
B3	B3	=IF($A$3<>"","RH","")
B4	B4	=IF($A$4<>"","DT","")
B5	B5	=IF($A$5<>"","IW","")
B7	B7	=IF($A$7<>"","RH","")
B8	B8	=IF(A8<>"","DT","")
B9	B9	=IF($A$9<>"","IW","")
B10	B10	=IF($A$10<>"","ST","")
B11	B11	=IF($A$11<>"","RH","")
B12	B12	=IF($A$12<>"","DT","")
B13	B13	=IF($A$13<>"","IW","")
B14	B14	=IF($A$14<>"","ST","")
B15	B15	=IF($A$15<>"","RH","")
B16	B16	=IF(A$16<>"","DT","")
B17	B17	=IF($A$17<>"","IW","")
B18	B18	=IF($A$18<>"","ST","")
B19	B19	=IF($A$19<>"","RH","")
B20	B20	=IF($A$20<>"","DT","")
B21	B21	=IF($A$21<>"","IW","")
B22	B22	=IF($A$22<>"","ST","")
B23	B23	=IF($A$23<>"","RH","")
B24	B24	=IF($A$24<>"","DT","")
B25	B25	=IF($A$25<>"","IW","")
B26	B26	=IF($A$26<>"","ST","")
B27	B27	=IF($A$27<>"","RH","")
B28	B28	=IF($A$28<>"","DT","")
B29	B29	=IF($A$29<>"","IW","")

 

[johnnyL]

Works fine for me.

 

[BraytonM]

Works fine for me.

I am not at work now, but I have tested this at home and it appears to work just fine. I will report back tomorrow morning when I have the template. Thank you.