VBA to insert Blank Rows According to Value in Column C

B

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

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
BraytonM said:
however, when the value in Column is <>0, it will insert that many blank rows above.
Click to expand...
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
maabadi said:
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
Click to expand...
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
maabadi said:
Then what is Problem with Code? It work correctly for me.
Click to expand...
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
maabadi said:
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.
Click to expand...
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.

PR Import and PER VBA_.xlsm .xlsm
ABCDEFGHIJKLMNOPVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAV
1Employee NoDELETE MEDELETE COUNTDELETEJob NoPhase NoCost CodeUnion NoEarn Code8/22/20218/23/20218/24/20218/25/20218/26/20218/27/20218/28/20218/22/20218/22/20218/22/20218/23/20218/23/20218/23/20218/23/20218/24/20218/24/20218/24/20218/24/20218/25/20218/25/20218/25/20218/25/20218/26/20218/26/20218/26/20218/26/20218/27/20218/27/20218/27/20218/27/20218/28/20218/28/20218/28/2021
2AAPLESST2       JOB1 u   JOB1 u   JOB2 u   JOB1 u      
3AAPLESRH0                          
4AAPLESDT0                          
5AAPLESIW0                          
6BBANANAST2       JOB1 u   JOB1 u   JOB2 u   JOB1 u      
7BBANANARH0                          
8BBANANADT0                          
9BBANANAIW0                          
MASTER COPY (3)
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
maabadi said:
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
Click to expand...
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
You must log in or register to reply here.

Similar threads

G
  • Question Question
Why does #VALUE error in VBA function occur when creating a ReDim Matrix of Stock prices from a Named Range?
Replies
2
Views
103
Peter_SSs
Peter_SSs
T
  • Solved
Populate Worksheet Rows Based on Userform Checkbox selection
2
Replies
11
Views
179
TellM1955
T
U
  • Solved
Rewrite Code as a Sub to work on Active Sheet
Replies
2
Views
53
Skyybot
Skyybot
lojanica
  • Question Question
How to execute VBA every 10 minutes?
2 3 4
Replies
33
Views
436
Logit
Logit
R
  • Question Question
VBA Check if value in Sheet1 exists in Sheet2 then copy specific cells from Sheet2 into Sheet1
2
Replies
13
Views
2K
dermie_72
D

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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