VBA to insert Blank Rows According to Value in Column C

BraytonM

New Member
Joined
Jul 25, 2021
Messages
24
Office Version
  1. 365
Hello all,

I have this VBA that does not work correctly when the value in Column C is "2". When I cell value is not "2," the VBA functions as it should. The idea if the value in Column C is blank, the VBA will delete the row; however, when the value in Column is <>0, it will insert that many blank rows above.

For instance, the VBA should produce the result of:

Row 2: Blank
Row 3: Blank
Row 4: AAPLES ST 2
Row 5: Blank
Row 6: Blank
Row 7: BBANANA ST 2
Row 8.... Blank

If anybody could help rewrite this so that the VBA works for "2" in Column C, I would greatly appreciate it.

The VBA that I have been using is below:

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


PR Import and PER VBA_.xlsm .xlsm
ABC
1Employee NoDELETE MEROW ABOVE #
2AAPLESST2
3AAPLESRH0
4AAPLESDT0
5AAPLESIW0
6BBANANAST2
7BBANANARH0
8BBANANADT0
9BBANANAIW0
100ST0
110RH0
120DT0
130IW0
140ST0
150RH0
160DT0
170IW0
180ST0
190RH0
200DT0
210IW0
220ST0
230RH0
240DT0
250IW0
260ST0
270RH0
280DT0
290IW0
MASTER COPY (2)
Cell Formulas
RangeFormula
A2:A29A2=RowTimesheet!T40
B2,B6B2=IF(A2<>"","ST","")
C2:C29C2=SUMPRODUCT((W2:AV2<>"")/COUNTIF(W2:AV2,W2:AV2&""))
B3B3=IF($A$3<>"","RH","")
B4B4=IF($A$4<>"","DT","")
B5B5=IF($A$5<>"","IW","")
B7B7=IF($A$7<>"","RH","")
B8B8=IF(A8<>"","DT","")
B9B9=IF($A$9<>"","IW","")
B10B10=IF($A$10<>"","ST","")
B11B11=IF($A$11<>"","RH","")
B12B12=IF($A$12<>"","DT","")
B13B13=IF($A$13<>"","IW","")
B14B14=IF($A$14<>"","ST","")
B15B15=IF($A$15<>"","RH","")
B16B16=IF(A$16<>"","DT","")
B17B17=IF($A$17<>"","IW","")
B18B18=IF($A$18<>"","ST","")
B19B19=IF($A$19<>"","RH","")
B20B20=IF($A$20<>"","DT","")
B21B21=IF($A$21<>"","IW","")
B22B22=IF($A$22<>"","ST","")
B23B23=IF($A$23<>"","RH","")
B24B24=IF($A$24<>"","DT","")
B25B25=IF($A$25<>"","IW","")
B26B26=IF($A$26<>"","ST","")
B27B27=IF($A$27<>"","RH","")
B28B28=IF($A$28<>"","DT","")
B29B29=IF($A$29<>"","IW","")
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
however, when the value in Column is <>0, it will insert that many blank rows above.
How many rows you want Insert for numbers More than 0?
at this module Number of rows added for each number is equal of value of Column C
Because of
Rich (BB code):
For j = 1 To a
ActiveSheet.Rows(i).Select
Selection.Insert Shift:=xlDown
Next
if you want only insert one row per each value <> 0 Then Remove red Parts
 
Upvote 0
How many rows you want Insert for numbers More than 0?
at this module Number of rows added for each number is equal of value of Column C
Because of
Rich (BB code):
For j = 1 To a
ActiveSheet.Rows(i).Select
Selection.Insert Shift:=xlDown
Next
if you want only insert one row per each value <> 0 Then Remove red Parts
Hello @maabadi , I am wanting to insert as many rows as the value in column C. If the value were to be 10, insert 10 blank rows, but if it is 0, then do not insert a row above.
 
Upvote 0
Then what is Problem with Code? It work correctly for me.
 
Upvote 0
Or Change That Part
VBA Code:
For j = 1 To a
 ActiveSheet.Rows(i).Select
 Selection.Insert Shift:=xlDown
 Next
to:
VBA Code:
ActiveSheet.Rows(i).Resize(j).Insert Shift:=xlDown
 
Upvote 0
Then what is Problem with Code? It work correctly for me.
I have done some testing and I think that the VBA is not recognizing my SUMPRODUCT Formula value. The formula is calculating correctly but the VBA is not recognizing that there is a "2." If I type "2" (w/o formula) it seems to work like it should.
 
Upvote 0
I test with Sumproduct formula and it works again correct. Pease upload sample file with Data at columns W:AV and ... to formula works correctly.
Then I test macro on it.
 
Upvote 0
I test with Sumproduct formula and it works again correct. Pease upload sample file with Data at columns W:AV and ... to formula works correctly.
Then I test macro on it.
I am currently working on a work around that calculates the SUMPRODUCT elsewhere and paste values only and seeing if that would suffice.

I have posted A: AV here.

Cell Formulas
RangeFormula
J1:O1J1=K1-1
P1P1='Weekly Timesheet'!C7
W1:Y1W1=$J$1
Z1:AC1Z1=$K$1
AD1:AG1AD1=$L$1
AH1:AK1AH1=$M$1
AL1:AO1AL1=$N$1
AP1:AS1AP1=$O$1
AT1:AV1AT1=$P$1
W2:W9W2=IF('Weekly Timesheet'!H16>0,CONCAT('Weekly Timesheet'!$H$5," ",'Weekly Timesheet'!$H$4,""),"")
X2:X9X2=IF('Weekly Timesheet'!I16>0,CONCAT('Weekly Timesheet'!$I$5," ",'Weekly Timesheet'!$I$4,""),"")
Y2:Y9Y2=IF('Weekly Timesheet'!J16>0,CONCAT('Weekly Timesheet'!$J$5," ",'Weekly Timesheet'!$J$4,""),"")
Z2:Z9Z2=IF('Weekly Timesheet'!K16>0,CONCAT('Weekly Timesheet'!$K$5," ",'Weekly Timesheet'!$K$4,""),"")
AA2:AA9AA2=IF('Weekly Timesheet'!L16>0,CONCAT('Weekly Timesheet'!$L$5," ",'Weekly Timesheet'!$L$4,""),"")
AB2:AB9AB2=IF('Weekly Timesheet'!M16>0,CONCAT('Weekly Timesheet'!$M$5," ",'Weekly Timesheet'!$M$4,""),"")
AC2:AC9AC2=IF('Weekly Timesheet'!N16>0,CONCAT('Weekly Timesheet'!$N$5," ",'Weekly Timesheet'!$N$4,""),"")
AD2:AD9AD2=IF('Weekly Timesheet'!O16>0,CONCAT('Weekly Timesheet'!$O$5," ",'Weekly Timesheet'!$O$4,""),"")
AE2:AE9AE2=IF('Weekly Timesheet'!P16>0,CONCAT('Weekly Timesheet'!$P$5," ",'Weekly Timesheet'!$P$4,""),"")
AF2:AF9AF2=IF('Weekly Timesheet'!Q16>0,CONCAT('Weekly Timesheet'!$Q$5," ",'Weekly Timesheet'!$Q$4,""),"")
AG2:AG9AG2=IF('Weekly Timesheet'!R16>0,CONCAT('Weekly Timesheet'!$R$5," ",'Weekly Timesheet'!$R$4,""),"")
AH2:AH9AH2=IF('Weekly Timesheet'!S16>0,CONCAT('Weekly Timesheet'!$S$5," ",'Weekly Timesheet'!$S$4,""),"")
AI2:AI9AI2=IF('Weekly Timesheet'!T16>0,CONCAT('Weekly Timesheet'!$T$5," ",'Weekly Timesheet'!$T$4,""),"")
AJ2:AJ9AJ2=IF('Weekly Timesheet'!U16>0,CONCAT('Weekly Timesheet'!$U$5," ",'Weekly Timesheet'!$U$4,""),"")
AK2:AK9AK2=IF('Weekly Timesheet'!V16>0,CONCAT('Weekly Timesheet'!$V$5," ",'Weekly Timesheet'!$V$4,""),"")
AL2:AL9AL2=IF('Weekly Timesheet'!W16>0,CONCAT('Weekly Timesheet'!$W$5," ",'Weekly Timesheet'!$W$4,""),"")
AM2:AM9AM2=IF('Weekly Timesheet'!X16>0,CONCAT('Weekly Timesheet'!$X$5," ",'Weekly Timesheet'!$X$4,""),"")
AN2:AN9AN2=IF('Weekly Timesheet'!Y16>0,CONCAT('Weekly Timesheet'!$Y$5," ",'Weekly Timesheet'!$Y$4,""),"")
AO2:AO9AO2=IF('Weekly Timesheet'!Z16>0,CONCAT('Weekly Timesheet'!$Z$5," ",'Weekly Timesheet'!$Z$4,""),"")
AP2:AP9AP2=IF('Weekly Timesheet'!AA16>0,CONCAT('Weekly Timesheet'!$AA$5," ",'Weekly Timesheet'!$AA$4,""),"")
AQ2:AQ9AQ2=IF('Weekly Timesheet'!AB16>0,CONCAT('Weekly Timesheet'!$AB$5," ",'Weekly Timesheet'!$AB$4,""),"")
AR2:AR9AR2=IF('Weekly Timesheet'!AC16>0,CONCAT('Weekly Timesheet'!$AC$5," ",'Weekly Timesheet'!$AC$4,""),"")
AS2:AS9AS2=IF('Weekly Timesheet'!AD16>0,CONCAT('Weekly Timesheet'!$AD$5," ",'Weekly Timesheet'!$AD$4,""),"")
AT2:AT9AT2=IF('Weekly Timesheet'!AE16>0,CONCAT('Weekly Timesheet'!$AE$5," ",'Weekly Timesheet'!$AE$4,""),"")
AU2:AU9AU2=IF('Weekly Timesheet'!AF16>0,CONCAT('Weekly Timesheet'!$AF$5," ",'Weekly Timesheet'!$AF$4,""),"")
AV2:AV9AV2=IF('Weekly Timesheet'!AG16>0,CONCAT('Weekly Timesheet'!$AG$5," ",'Weekly Timesheet'!$AG$4,""),"")
A2:A9A2=RowTimesheet!T40
B2,B6B2=IF(A2<>"","ST","")
C2:C9C2=SUMPRODUCT((W2:AV2<>"")/COUNTIF(W2:AV2,W2:AV2&""))
B3B3=IF($A$3<>"","RH","")
B4B4=IF($A$4<>"","DT","")
B5B5=IF($A$5<>"","IW","")
B7B7=IF($A$7<>"","RH","")
B8B8=IF(A8<>"","DT","")
B9B9=IF($A$9<>"","IW","")
 
Upvote 0
I Test again with your data and it works. i upload sample file with your Data Uploaded. Check Sheet Data.
Also I added code to VBA.
Sample1.xlsm
 
Upvote 0
Solution
I Test again with your data and it works. i upload sample file with your Data Uploaded. Check Sheet Data.
Also I added code to VBA.
Sample1.xlsm
Thank you for all your help @maabadi. I tried again and the only way I would fix it was changing my SUMPRODUCT((W2:AV2<>"")/COUNTIF(W2:AV2,W2:AV2&"" to =IF(SUMPRODUCT((W2:AV2<>"")/COUNTIF(W2:AV2,W2:AV2&""))=0,,(SUMPRODUCT((W2:AV2<>"")/COUNTIF(W2:AV2,W2:AV2&""))+1)).

Essentially, this added added 1 to the cell value in Column C and created a work-around for this situation.
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top