Insert Rows Based on criteria (or CountIf?)

hutch27

New Member
Joined
May 5, 2014
Messages
37
Hello,

I have two tabs, a summary tab, and a Data Tab. The Data Tab is organized like this (from rows 2 to 300 - with each person having a different number in Column E).

Column BColumn E
Person 1 (row 2)10
Person 2 (row 3)2
Person 3 (row 4)0
Person 4 (row 5)...1
Person 5 ...(row 300)0

<tbody>
</tbody>

I would like to add rows on the Summary tab (starting in row 4) equal to the total number of people on the Data tab that have a value in Column E > 0.

Therefore, using the example above, the macro would add in 3 new rows (starting on row 4) on the Summary tab, because there are 3 people on the Data Tab that have values in Column E > 0.

Thanks!
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Try this:
Code:
Sub Copy_Me_Maybe()
'Modified  7/19/2019  6:49:38 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrowa As Long
Dim Lastrow As Long
Sheets("Data").Activate
Lastrow = Sheets("Data").Cells(Rows.Count, "E").End(xlUp).Row
For i = 2 To Lastrow
    If Cells(i, "E").Value > 0 Then
        Lastrowa = Sheets("Summary").Cells(Rows.Count, "E").End(xlUp).Row + 1
        If Lastrowa < 4 Then Lastrowa = 4
        Rows(i).Copy Sheets("Summary").Rows(Lastrowa)
    End If
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Or try this using Filter:
Code:
Sub Filter_Me_Please()
'Modified  7/19/2019  7:38:46 AM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Sheets("Data").Activate
Dim c As Long
Dim s As Variant
c = 5 ' Column Number Modify this to your need
s = ">" & 0 'Search Value Modify to your need
lastrow = Cells(Rows.Count, c).End(xlUp).Row
Dim Counter As Long
With ActiveSheet.Cells(1, c).Resize(lastrow)
    .AutoFilter 1, s
    Counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If Counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Summary").Rows(4)
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Sorry,

After re-reading my initial question I may have been a little too vague on my request. Let me try re-phrasing again!

I have two tabs, a summary tab and a data tab. The Summary Tab is constructed like this:

Column AColumn BColumn CColumn DColumn E
TitleTitleTitleTitleTitleRow #1
Blank (N/A)Blank (N/A)Blank (N/A)Blank (N/A)Blank (N/A)Row #2
Header 1Header 2Header 3Header 4Header 5Row #3
DataDataDataDataDataRow #4
DataDataDataDataDataRow #5
SubtotalSubtotalSubtotalSubtotalSubtotalRow #6

<tbody>
</tbody>


The Data Tab is Constructed like this (note - it only goes up until row 300)

Column AColumn BColumn CColumn DColumn E
Title APeopleTitleTitleAmountRow #1
DataPerson 1DataData$500.00Row #2
DataPerson 2DataData$0.00Row #3
DataPerson 3DataData$400.00Row #4
DataPerson 4DataData$0.00Row #5
DataPerson 300DataData$300.00Row #300

<tbody>
</tbody>

My goal is to:

  1. Count the number of persons (column B - Data Tab) that have Amounts (Column E - Data Tab) > $0.00. So, for this example, there are 3 persons who have amounts > $0.00.
  2. On the Summary Tab, insert blank rows, below row #4 , equal to the number of persons that have amounts > $0.00 on the Data Tab.

The end result of the Summary Tab would be this:

Column AColumn BColumn CColumn DColumn E
TitleTitleTitleTitleTitleRow #1
Blank (N/A)Blank (N/A)Blank (N/A)Blank (N/A)Blank (N/A)Row #2
Header 1Header 2Header 3Header 4Header 5Row #3
DataDataDataDataDataRow #4
DataDataDataDataDataRow #5
(Newly inserted blank row)(Newly inserted blank row)(Newly inserted blank row)(Newly inserted blank row)(Newly inserted blank row)Row #6
(Newly inserted blank row)(Newly inserted blank row)(Newly inserted blank row)(Newly inserted blank row)(Newly inserted blank row)Row #7
(Newly inserted blank row)(Newly inserted blank row)(Newly inserted blank row)(Newly inserted blank row)(Newly inserted blank row)Row #8
SubtotalSubtotalSubtotalSubtotalSubtotalRow #9

<tbody>
</tbody>


Please let me know if this helps clarify my original question.

Thank you!
 
Last edited:
Upvote 0
Try this:
Code:
Sub Insert_Rows()
'Modified  7/19/2019  5:33:32 PM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Sheets("Data").Activate
lastrow = Cells(Rows.Count, "E").End(xlUp).Row
Dim ans As Long
ans = Application.WorksheetFunction.CountIf(Range("E1:E" & lastrow), ">0")
Sheets("Summary").Rows(4).Resize(ans).Insert
Application.ScreenUpdating = True
End Sub
 
Upvote 0
I believe this function of the code is deriving an answer from the Summary Tab - how would i change it so that the answer counts all values > 0 on the Data tab?

ans = Application.WorksheetFunction.CountIf(Range("E1:E" & lastrow), ">0")
 
Upvote 0
If you see on line 5 of the code it says Sheets("Data") activate

So the count is coming from column E of sheet named Data

So your saying it's not working properly?

It looks down column E on sheet named Data for values greater then 0 to the last row with data in column E

Not just to row 300

Are you sure you only want it to look to row 300 my script looks to last row in column E with data.
 
Upvote 0
To answer your last question, yes, I would only want it to look to row 300.

However, it seems the code is not working properly. I re-tested it and am able to confirm that the number of rows added on the Summary Tab is equal to the total number of cells in Column E, on the Summary Tab (not the Data Tab), that are > 0
 
Last edited:
Upvote 0
Try this:
I test all my scripts and it worked for me but try this:
Code:
Sub Insert_Rows()
'Modified  7/19/2019  7:25:22 PM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
lastrow = 300
Dim ans As Long
ans = Application.WorksheetFunction.CountIf(Sheets("Data").Range("E1:E" & lastrow), ">0")
Sheets("Summary").Rows(4).Resize(ans).Insert
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Great, this one seems to be working as intended - I appreciate the quick follow up and I hope I was clear with my explanations!
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,954
Members
448,535
Latest member
alrossman

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